perm filename L[NEW,LSP]1 blob
sn#657778 filedate 1982-05-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00213 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 -*-MIDAS-*-
C00011 00003
C00015 00004
C00018 00005
C00020 00006
C00022 00007
C00025 00008
C00028 00009
C00031 00010
C00034 00011
C00038 00012
C00041 00013
C00046 00014
C00048 00015
C00050 00016
C00053 00017
C00060 00018
C00064 00019
C00066 00020
C00072 00021
C00074 00022
C00079 00023
C00083 00024
C00086 00025
C00090 00026
C00094 00027
C00097 00028
C00100 00029
C00104 00030
C00109 00031
C00115 00032
C00118 00033
C00122 00034
C00123 00035
C00126 00036
C00130 00037
C00135 00038
C00142 00039
C00153 00040
C00155 00041
C00167 00042
C00171 00043
C00174 00044
C00180 00045
C00185 00046
C00188 00047
C00191 00048
C00194 00049
C00198 00050
C00200 00051
C00201 00052
C00206 00053
C00213 00054
C00216 00055
C00219 00056
C00223 00057
C00229 00058
C00232 00059
C00234 00060
C00236 00061
C00239 00062
C00241 00063
C00244 00064
C00249 00065
C00253 00066
C00256 00067
C00259 00068
C00261 00069
C00264 00070
C00267 00071
C00270 00072
C00272 00073
C00275 00074
C00281 00075
C00283 00076
C00286 00077
C00289 00078
C00292 00079
C00296 00080
C00298 00081
C00301 00082
C00304 00083
C00307 00084
C00308 00085
C00314 00086
C00316 00087
C00317 00088
C00318 00089
C00321 00090
C00325 00091
C00332 00092
C00335 00093
C00337 00094
C00339 00095
C00342 00096
C00344 00097
C00347 00098
C00350 00099
C00352 00100
C00355 00101
C00357 00102
C00360 00103
C00364 00104
C00367 00105
C00371 00106
C00373 00107
C00375 00108
C00377 00109
C00379 00110
C00381 00111
C00388 00112
C00392 00113
C00395 00114
C00399 00115
C00402 00116
C00405 00117
C00408 00118
C00411 00119
C00416 00120
C00420 00121
C00424 00122
C00426 00123
C00428 00124
C00434 00125
C00436 00126
C00438 00127
C00441 00128
C00445 00129
C00446 00130
C00450 00131
C00457 00132
C00458 00133
C00463 00134
C00466 00135
C00470 00136
C00473 00137
C00476 00138
C00478 00139
C00487 00140
C00491 00141
C00495 00142
C00500 00143
C00506 00144
C00509 00145
C00515 00146
C00517 00147
C00521 00148
C00524 00149
C00526 00150
C00528 00151
C00532 00152
C00535 00153
C00539 00154
C00543 00155
C00545 00156
C00549 00157
C00551 00158
C00553 00159
C00555 00160
C00557 00161
C00560 00162
C00570 00163
C00576 00164
C00582 00165
C00585 00166
C00587 00167
C00590 00168
C00592 00169
C00593 00170
C00598 00171
C00611 00172
C00621 00173
C00629 00174
C00634 00175
C00641 00176
C00647 00177
C00648 00178
C00649 00179
C00651 00180
C00655 00181
C00658 00182
C00659 00183
C00661 00184
C00664 00185
C00668 00186
C00671 00187
C00676 00188
C00681 00189
C00684 00190
C00687 00191
C00689 00192
C00692 00193
C00694 00194
C00697 00195
C00700 00196
C00702 00197
C00705 00198
C00707 00199
C00709 00200
C00711 00201
C00713 00202
C00716 00203
C00718 00204
C00721 00205
C00726 00206
C00737 00207
C00742 00208
C00744 00209
C00747 00210
C00749 00211
C00752 00212
C00756 00213
C00758 ENDMK
C⊗;
;;; -*-MIDAS-*-
;;; **************************************************************
;;; ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
;;; **************************************************************
;;; ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
IFE .OSMIDAS-SIXBIT \TWENEX\,.SYMTAB 17393. ;2001.st prime
.ELSE .SYMTAB 16001. ;1863.rd prime
TITLE ***** MACLISP ****** LISP INTERPRETER AND SYSTEM *************
.NSTGWD ;NO STORAGE WORDS PLEASE UNTIL FIRSTLOC
.XCREF A,B,C,AR1,AR2A,T,TT,D,R,F,P,FXP,%
.MLLIT==1
SUBTTL ASSEMBLY PARAMETERS
IF1,[ ;***** CONDITIONAL ASSEMBLY FLAGS AND PARAMETERS *****
;" FOR ASSLIS - DO NOT PUT ANY OTHER DOUBLE QUOTES ON THIS PAGE
ITS==0 ;1 FOR RUNNING UNDER THE ITS MONITOR
TOPS10==0 ;1 FOR RUNNING UNDER DEC TOPS-10 MONITOR
TOPS20==0 ;1 FOR RUNNING UNDER DEC TOPS-20 MONITOR
SAIL==0 ;1 FOR RUNNING UNDER SAIL MONITOR
TENEX==0 ;1 FOR RUNNING UNDER THE TENEX MONITOR
CMU==0 ;1 FOR RUNNING UNDER THE CMU MONITOR
;LATER WE WILL DEFINE D10==TOPS10\SAIL\CMU AND D20==TENEX\TOPS20
ML==0 ;1 SAYS THIS LISP IS FOR ML (OR MC) INSTEAD OF AI (ONLY IF ITS==1)
BIGNUM==1 ;MULTIPLE PRECISION ROUTINES FLAG
OBTSIZ==777 ;LENGTH OF OBLIST
PTCSIZ==20. ;MINIMUM SIZE FOR PATCH AREA
NEWRD==0 ;NEW READER FORMAT ETC
JOBQIO==1 ;SUPPORT FOR INFERIOR PROCEDURES
HNKLOG==9 ;LOG2 OF SIZE (IN WORDS) OF LARGEST HUNK (0 => NO HUNKS)
PDLBUG==SAIL ;PROCESSOR/OPSYS HAS PROBLEMS WITH PDL OVERFLOWS
SFA==1 ;1 FOR SFA I/O
NIOBFS==1 ;NUMBER OF I/O BUFFERS FOR D10 SYSTEMS
USELESS==1 ;NOT PARTICULARLY IMPORTANT FEATURES, LIKE:
; 1) ROMAN NUMERAL READER AND PRINTER
; 2) PRINLEVEL AND PRINLENGTH
; 3) DOUBLE-PRECISION INPUT OF SINGLE-PRECISION FLONUMS
; 4) CURSORPOS
; 5) GCD
; 6) DUMPARRAYS, LOADARRAYS [AUTOLOADED IN NEWIO]
; 7) RECLAIM, AND RETSP FEATURE WHICH RETURNS BPS CORE TO TS SYSTEM
; 8) PURIFY, AND PURE-INITIAL-READ-TABLE
; 9) CLI INTERRUPT SUPPORT
; 10) MAR-BREAK SUPPORT
; 11) AUTOLOAD PROPERTIES FOR ALLFILES ETC.
; 13) CLEVER TERPRI-BEFORE-THE-PARENS HACK
; 14) HUGE TABLE FOR RANDOM NUMBER GENERATOR
; 15) Exchange A and CONSed hunk
DBFLAG==0 ;1 FOR DOUBLE-PRECISION FLOATING-POINT NUMBERS
CXFLAG==0 ;1 FOR COMPLEX ARITHMETIC
;; IF EITHER THE DBFLAG OR CXFLAG ARE SET, THE THE FLAGS KA, KI, AND KL MUST BE
;; SET. OR ELSE, MAYBE, GO THRU AND REMOVE THEIR USAGE. JONL - 10/16/80
NARITH==0 ;1 FOR NEW ARITHMETIC PACKAGE
;" FOR ASSLIS - DOUBLE QUOTES ARE OKAY NOW
;;; IF1
SUBTTL STORAGE LAYOUTS
;;; STORAGE LAYOUT FOR ITS
;;;
;;; BZERSG 0 - - LOW PAGES
;;; ACCUMULATORS, TEMPORARY VARIABLES,
;;; INITIAL READTABLE AND OBARRAY
;;; BSTSG ST: - - SEGMENT TABLES
;;; BSYSSG FIRSTL: INITIAL SYSTEM CODE (PURE)
;;; BSARSG INITIAL SAR SPACE
;;; BVCSG INITIAL VALUE CELL SPACE
;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
;;; BIS2SG SYMBOL-BLOCKS
;;; BSYMSG SYMBOL-HEADERS
;;; BSY2SG **SYMBOL-BLOCKS
;;; BPFXSG **FIXNUMS
;;; BPFSSG **LIST-STRUCTURE
;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
;;; BIFSSG LIST-STRUCTURE
;;; BIFXSG FIXNUMS
;;; BIFLSG FLONUMS
;;; BBNSG BIGNUMS
;;; BBITSG BIT BLOCKS FOR GC
;;; BBPSSG START OF BINARY PROGRAM SPACE
;;; C(BPSL) (ALLOC IS IN THIS AREA)
;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
;;; C(BPSH) LAST WORD OF BPS
;;; ... BINARY PROGRAM SPACE GROWS UPWARD ...
;;; C(HINXM) LAST WORD OF GROSS HOLE IN MEMORY
;;; ... LIST STRUCTURE GROWS DOWNWARD ...
;;; PUSHDOWN LISTS WITH HOLES BETWEEN:
;;; FXP, FLP, P, SP
;;;
;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
;;;
;;; STORAGE LAYOUT FOR DEC10
;;;
;;; ***** LOW SEGMENT *****
;;; BZERSG 0 - - LOW PAGES
;;; ACCUMULATORS, TEMPORARY VARIABLES,
;;; INITIAL READTABLE AND OBARRAY
;;; BSTSG ST: - - SEGMENT TABLES
;;; BSARSG INITIAL SAR SPACE
;;; BVCSG INITIAL VALUE CELL SPACE
;;; BXVCSG [EXTRA VALUE-CELL SEGMENTS - - POSSIBLY NONE]
;;; BIS2SG SYMBOL-BLOCKS
;;; BSYMSG SYMBOL-HEADERS
;;; BIFSSG LIST-STRUCTURE
;;; BIFXSG FIXNUMS
;;; BIFLSG FLONUMS
;;; BBNSG BIGNUMS
;;; BBITSG BIT BLOCKS FOR GC
;;; PUSHDOWN LISTS:
;;; FXP, FLP, P, SP
;;; C(NPDLL) LOW WORD OF NUMBER PDL (LOW OF FXP)
;;; C(NPDLH) HIGH WORD OF NUMBER PDL + 1 (HIGH+1 OF FLP)
;;; BBPSSG START OF BINARY PROGRAM SPACE
;;; (ALLOC IS IN THIS AREA)
;;; V(BPORG) START OF BPS UNUSED FOR PROGRAMS
;;; V(BPEND) ARRAYS START NO LOWER THAN THIS
;;; C(BPSH) LAST WORD OF BPS (FIXED, SET BY ALLOC)
;;; C(HIXM) HIGH WORD OF EXISTING MEMORY
;;; C(MAXNXM) HIGHEST WORD OF NXM THAT MAY BE USED
;;;
;;; ***** HIGH SEGMENT *****
;;; BSYSSG INITIAL SYSTEM CODE (PURE)
;;; BSY2SG **SYMBOL-BLOCKS
;;; BPFXSG **FIXNUMS
;;; BPFSSG **LIST-STRUCTURE
;;; BPFLSG [**FLONUMS - - POSSIBLY NONE]
;;; BPFSSG INITIAL PURE LIST STRUCTURE
;;; IF1
SUBTTL VARIOUS PARAMETER CALCULATIONS
IFE <.OSMIDAS-<SIXBIT /SAIL/>>, OSD10P==1
IFE <.OSMIDAS-<SIXBIT /CMU/>>, OSD10P==1
IFE <.OSMIDAS-<SIXBIT /TOPS10/>>, OSD10P==1
IFNDEF OSD10P, OSD10P==0
;;; HACK FLAGS AND PARAMETERS
DEFINE ZZZZZZ X,SYM,VAL
IFSE [X]-, PRINTX \* \
.ELSE PRINTX \ \
PRINTX \SYM=VAL
\
TERMIN
PRINTX \ASSEMBLING MACLISP -- INITIAL SWITCH VALUES (*=EXPERIMENTAL):
\
;X=- => EXPERIMENTAL SWITCH
IRPS S,X,[ITS,TOPS10,TOPS20,SAIL,TENEX-CMU-
ML,BIGNUM,OBTSIZ,JOBQIO,HNKLOG,USELESS,
PDLBUG,DBFLAG-CXFLAG-NARITH-SFA-]
ZZZZZZ [X]S,\S
TERMIN
EXPUNGE ZZZZZZ
PRINTC \REDEFINITIONS:
\
.INSRT TTY:
PRINTC \
\
IFNDEF HSGORG,HSGORG==400000
IFN SAIL,[PDLBUG==1] ;SET PDLBUG FLAG
;;; ALL FLAGS WHICH ARE NON-ZERO MUST BE ONES: MUCH CONDITIONAL
;;; ASSEMBLY DOES ARITHMETIC WITH THEM.
IRP FOO,,[ITS,TOPS10,TOPS20,SAIL,TENEX,CMU
ML,BIGNUM,NEWRD,JOBQIO,USELESS
DBFLAG,CXFLAG,NARITH,SFA]
IFN FOO, FOO==:1
.ELSE FOO==:0
TERMIN ;USE OF ==: PREVENTS CHANGING THEM RANDOMLY
;;; CHECK MUTUALLY EXCLUSIVE FLAGS OF WHICH ONE MUST BE SET
DEFINE MUTXOR FLAGS,DEFAULT
ZZZ==0
IRP X,Y,[FLAGS]
ZZZ==ZZZ+X
IRP Z,,[Y]
IFN X*Z, .FATAL BOTH X AND Z SPECIFIED AMONG {FLAGS}
TERMIN
TERMIN
IFE ZZZ,[
PRINTX \NONE OF {FLAGS} SPECIFIED - ASSUMING DEFAULT==:1
\
EXPUNGE DEFAULT
DEFAULT==:1
] ;END OF IFE ZZZ
EXPUNGE ZZZ
TERMIN
ZZZ==
IRP OS,,[ITS,DEC,TWENEX,SAIL,TENEX,CMU]FLAG,,[ITS,TOPS10,TOPS20,SAIL,TENEX,CMU]
IFN FLAG,ZZZ==1
IFE .OSMIDAS-<SIXBIT \OS\>, MUTXOR [ITS,TOPS10,TOPS20,SAIL,TENEX,CMU]FLAG
TERMIN
IFSE ZZZ,,[
IRP OS,,[ITS,DEC,TWENEX,SAIL,TENEX,CMU]FLAG,,[ITS,TOPS10,TOPS20,SAIL,TENEX,CMU]
IFE .OSMIDAS-<SIXBIT \OS\>, FLAG==:1
TERMIN
]
;;; IF1
D10==:TOPS10\SAIL\CMU ;SWITCH FOR DEC-10-LIKE SYSTEMS
D20==:TOPS20\TENEX ;SWITCH FOR DEC-20-LIKE SYSTEMS
IFNDEF PAGING, PAGING==:D20\ITS ;SWITCH FOR PAGING SYSTEMS
IFNDEF HISEGMENT, HISEGMENT==:D10*<1-PAGING> ;ASSUME HISEGMENT FOR DEC-10
;;; INSIST FORCIBLY ALTERS A PARAMETER IF NECESSARY.
DEFINE INSIST COND,SET
COND,[
IRPS X,,[SET]
ZZZ==X
EXPUNGE X
SET
IFN X-ZZZ,[
PRINTX \ COND =>SET
\
]
EXPUNGE ZZZ
.ISTOP
TERMIN
] ;END OF COND
TERMIN
;;; CANONICALIZE BITS
INSIST IFE ITS, JOBQIO==:0
INSIST IFG SAIL*<6-NIOBFS>, NIOBFS==:6
SEGLOG==:11 ;LOG2 OF # OF WORDS PER SEGMENT (WARNING! BUILT INTO NCOMPLR!)
INSIST IFG HNKLOG-SEGLOG, HNKLOG==:SEGLOG-1
OBTSIZ==:OBTSIZ\1 ;MUST BE ODD
DXFLAG==:DBFLAG*CXFLAG
IFE .OSMIDAS-<SIXBIT \ITS\>,[
DEFINE $INSRT $%$%$%
.INSRT $%$%$% >
PRINTX \ ==> INSERTED: \
.TYO6 .IFNM1
PRINTX \ \
.TYO6 .IFNM2
PRINTX \
\
TERMIN
] ;END OF IFE .OSMIDAS-<SIXBIT \ITS\>,
.ELSE,[
DEFINE $INSRT $%$%$%
.INSRT $%$%$%!.MID
PRINTX \INSERTED: \
.TYO6 .IFNM1
PRINTX \.\
.TYO6 .IFNM2
PRINTX \
\
TERMIN
] ;END OF .ELSE
COMMENT | MAKE @ PROGRAM UNDERSTAND POTENTIAL FILE INSERTIONS
;TABS IN FRONT OF $INSRT'S ARE NECESSARY TO FAKE OUT UNIFY PROGRAM
$INSRT ITSDFS
$INSRT DECDFS
$INSRT TNXDFS
$INSRT SAIDFS
$INSRT ITSBTS
$INSRT DECBTS
$INSRT TWXBTS
| ;END OF COMMENT
IFE OSD10P,[
DEFINE A67IFY A,B,C
A=SIXBIT \C\
B=C
TERMIN
RADIX 10.
ZZ==.FVERS
;; Remember, somday cross over to 3000.
IFE .OSMIDAS-<SIXBIT \ITS\>, ZZ==2000.+ZZ
A67IFY LVRNO,LVRNON,\ZZ
RADIX 8
] ;END OF IFE OSD10P
IFN OSD10P,[
IFNDEF LVRNO,LVRNO=.FNAM2
IFE LVRNO-SIXBIT \MID\,[
PRINTX /What is LISP's version number (type four octal digits) ?/
.TTYMAC VRS
LVRNO=SIXBIT \VRS\
LVRNON=VRS
TERMIN
]
.ELSE,[
LVRNO==<LVRNO←-6>+<SIXBIT \1\> ;HACK FOR CROSSING 1000'S
IFN <<LVRNO←-30>&77>-'9, LVRNO==LVRNO+<1←36> ;HACK FOR CROSSING 2000'S
;;; REMEMBER! SOMEDAY WE MAY HAVE TO CROSS TO 3000'S - JONL, 9 JUL 1980
LVRNO==0
] ;END OF IFGE LVRNO
] ;END OF IFN OSD10P
PRINTX \MACLISP VERSION \ ;PRINT OUT VERSION OF THIS LISP
.TYO6 LVRNO
PRINTX \ ASSEMBLED ON \
.TYO6 .OSMIDAS
PRINTX \ AT \
IFE <.SITE 0>, PRINTX \UNKNOWN SITE\
.ELSE REPEAT 20, IFE <.SITE .RPCNT>,[.ISTOP] .TYO6 <.SITE .RPCNT>
PRINTX \
\ ;TERPRI TO FINISH VERSION MESSAGE
;;; IF1
;;; MAKE SURE THE SYMBOLS WE WILL NEED ARE DEFINED.
;;; THEY MAY NOT BE IF ASSEMBLING FOR A DIFFERENT OPERATING SYSTEM
DEFINE FLUSHER DEF/
IRPS SYM,,[DEF]
EXPUNGE SYM
.ISTOP
TERMIN
TERMIN
DEFINE SYMFLS TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
IFE <.OSMIDAS-SIXBIT\OS\>,[
IFE TARGETSYS,[
PRINTX \FLUSHING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER FLUSHER
IFSN .BITS.,,[
PRINTX \FLUSHING OS BIT DEFINITIONS
\
EQUALS DEFSYM,FLUSHER
$INSRT .BITS.
EXPUNGE DEFSYM
] ;END OF IFSN .BITS.
] ;END OF IFE TARGETSYS
] ;END OF IFE <.OSMIDAS-SIXBIT\OS\>
TERMIN
DEFINE SYMDEF TARGETSYS,OS,.DEFS.,DEFFER,CHKSYM,.BITS.,CHKBIT
IFN TARGETSYS,[
IFN <.OSMIDAS-SIXBIT\OS\>,[
PRINTX \MAKING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER
IFSN .BITS.,,[
PRINTX \MAKING OS BIT DEFINITIONS
\
$INSRT .BITS.
] ;END OF IFSN .BITS.,,
] ;END OF IFN <.OSMIDAS-SIXBIT\OS\>
.ELSE,[
IFNDEF CHKSYM,[
PRINTX \FUNNY - RUNNING ON OS, BUT CHKSYM UNDEFINED; MAKING OS SYMBOL DEFINITIONS
\
$INSRT .DEFS.
DEFFER
] ;END OF IFNDEF CHKSYM
IFSN .BITS.,,[
IFNDEF CHKBIT,[
PRINTX \FUNNY - RUNNING ON OS, BUT CHKBIT UNDEFINED; MAKING OS BIT DEFINITIONS
\
$INSRT .BITS.
] ;END OF IFNDEF CHKBIT
] ;END OF IFSN .BITS.,,
] ;END OF .ELSE
] ;END OF IFN TARGETSYS
TERMIN
;;; IF1
IFN D20, EXPUNGE RESET
IRP HACK,,[SYMFLS,SYMDEF]
HACK ITS,ITS,ITSDFS,.ITSDF,.IOT,ITSBTS,%PIC.Z
HACK TOPS10,DEC,DECDFS,.DECDF,LOOKUP,DECBTS,.GTSTS
HACK TOPS20,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK TENEX,TENEX,TNXDFS,.TNXDF,JSYS,TWXBTS,GJ%FOU
HACK SAIL,SAIL,SAIDFS,.DECDF,SPCWAR,DECBTS,.GTSTS
TERMIN
;;; CONFLICTS WITH UNLOCKI MACRO AND SEGSIZ VARIABLE
IFN D10,[
IFE SAIL,[
IFN <.OSMIDAS-SIXBIT\CMU\>,[
;THE FOLLOWING ARE THE SPECIAL CMU UUOs:
DEFINE .CMUCL DEF
DEF SRUN=:47000777756
DEF USRDEF=:47000777757
DEF JENAPX=:47000777760
DEF IMPUUO=:47000777761
DEF PRIOR=:47000777762
DEF LNKRDY=:47000777763
DEF INT11=:47000777764
DEF RSTUUO=:47000777765
DEF UNTIME=:47000777766
DEF TIME=:47000777767
DEF STOP=:47000777770
DEF UNLOCK=:47000777771
DEF JENAPR=:47000777772
DEF MSGPOL=:47000777773
DEF MSGSND=:47000777774
DEF DECCMU=:47000777775
DEF CMUDEC=:47000777776
TERMIN
PRINTX \MAKING CMU-SPECIFIC "CALL" DEFINITIONS
\
.CMUCL FLUSHER
.CMUCL
] ;END OF IFN <.OSMIDAS-SIXBIT\CMU\>
] ;END OF IFE SAIL
IFN SAIL, EXPUNGE SEGSIZ
EXPUNGE UNLOCK
] ;END OF IFN D10
IFN D10,[
DEFINE HALT
JRST 4,.!TERMIN
EXPUNGE .VALUE
EQUALS .VALUE HALT
DEFINE .LOSE <A>
JRST 4,.-1!TERMIN
] ;END OF IFN D10
;;; IF1
IFN D20,[
GETTAB==:47←33 41
%TOCID==:1
%TOLID==:2
%TOMVU==:400
%TOMVB==:10000
%TOERS==:40000
%TOOVR==:0
DEFINE HALT
HALTF!TERMIN
EXPUNGE .VALUE
EQUALS .VALUE HALTF
DEFINE .LOSE <A>
HALTF!TERMIN
] ;END OF IFN D20
;;; CALL IS A DEC UUO, BUT WE USE THAT NAME FOR A LISP UUO
EXPUNGE CALL
;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
$INSRT FASDFS ;STANDARD AC, UUO, AND MACRO DEFINITIONS
;;; DON'T HACK THIS $INSRT - UNIFY DEPENDS ON IT
$INSRT MACS ;LOTSA MOBY MACROS
SA% LRCT==:NASCII+10 ;SPACE SUFFICIENT FOR CHARS AND SWITCHES
SA$ LRCT==:1010
10$ LIOBUF==:200 ;LENGTH OF STANDARD VANILLA I/O BUFFER
LONUM==400 ;MINIMUM MAGNITUDE OF LOWEST NEGATIVE INUM
HINUM==1000 ;MINIMUM MAGNITUDE OF LARGEST POSITIVE INUM
;SOME CODE ASSUMES HINUM IS AT LEAST 777
;MUCH CODE ASSUMES HINUM IS AT LEAST 177 (FOR ASCII CHARS)
IFN ITS, PAGLOG==:12 ;LOG2 OF PAGE SIZE
; (DAMN WELL BETTER BE 12 FOR ITS!!!
IFN D10, PAGLOG==:11 ; SOME CODE ASSUMES IT WILL BE 11 OR 12)
IFN D20, PAGLOG==:11
IFE D10*PAGING, MEMORY==:<1,,0> ;SIZE OF MEMORY!!!
IFN D10*PAGING, MEMORY==:776000 ;ON D10 SYSTEMS, CAN'T USE ALL OF MEMORY
PAGSIZ==:1←PAGLOG ;PAGE SIZE
PAGMSK==:<777777←PAGLOG>&777777 ;MASKS ADDRESSES TO PAGE BOUNDARY
PAGKSM==:PAGMSK#777777 ;MASKS WORD ADDRESS WITHIN PAGE
NPAGS==:MEMORY/PAGSIZ ;NUMBER OF PAGES IN MEMORY
NNUMTP==:2+BIGNUM+DBFLAG+CXFLAG+DBFLAG*CXFLAG ;NUMBER OF NUMBER TYPES
NTYPES==:3+HNKLOG+1+NNUMTP+1 ;NUMBER OF DATA TYPES, COUNTING RANDOM
;;; IF1
SEGSIZ==:1←SEGLOG ;SEGMENT SIZE
SEGMSK==:<777777←SEGLOG>&777777 ;MASKS ADDRESSES TO SEGMENT BOUNDARY
SEGKSM==:SEGMSK#777777 ;MASKS WORD ADDRESS WITHIN SEGMENT
NSEGS==:MEMORY/SEGSIZ ;NUMBER OF SEGMENTS IN MEMORY
BTBSIZ==:SEGSIZ/40 ;SIZE OF BIT BLOCKS
;(ENOUGH BITS FOR A SEGMENT, 40 PER WORD)
SGS%PG==:NSEGS/NPAGS ;NUMBER OF SEGMENTS PER PAGE
BTSGGS==1 ;GUESS AT THE NUMBER OF INITIAL BIT SEGMENTS
IFN PAGING,[
ALPDL==4096. ;DEFAULT TOTAL PDL SIZES
ALFXP==2048.
ALFLP==1*PAGSIZ
ALSPDL==2048.
] ;END OF IFN ITS+D20
IFE PAGING,[
ALFXP==SEGSIZ ;DEFAULT TOTAL PDL SIZES
ALFLP==SEGSIZ
ALPDL==3000
ALSPDL==1400
] ;END OF IFN D10
;;; GROSSLY DETERMINE MIN AND MAX PARAMETERS FOR EACH SPACE AND PDL
FUMBLE FFS,,[[1,[0.25,40000]]]
FUMBLE FFX,,[[PAGING,[0.2,14000]],[PAGING-1,[0.25,3000]]]
FUMBLE FFL,,[[PAGING,[0.15,2*SEGSIZ]],[PAGING-1,[0.25,SEGSIZ]]]
FUMBLE FFD,IFN DBFLAG,[[1,[0,SEGSIZ]]]
FUMBLE FFC,IFN CXFLAG,[[1,[0,SEGSIZ]]]
FUMBLE FFZ,IFN DXFLAG,[[1,[0,SEGSIZ]]]
FUMBLE FFB,IFN BIGNUM,[[PAGING,[3*SEGSIZ/4,2*SEGSIZ]],[PAGING-1,[0.2,SEGSIZ]]]
FUMBLE FFY,,[[PAGING,[SEGSIZ/2,6000]],[PAGING-1,[SEGSIZ/2,3*SEGSIZ]]]
FUMBLE FFH,IFN HNKLOG,[[1,[0,2*SEGSIZ]]]
FUMBLE FFA,,[[1,[40,SEGSIZ]]]
GRUMBLE PDL,,[[1,[200,1400]]]
GRUMBLE SPDL,,[[1,[100,1400]]]
GRUMBLE FXP,,[[1,[200,1000]]]
GRUMBLE FLP,,[[1,[20,200]]]
;;; IF1
;;; ********** INTERRUPT BITS **********
IFN ITS,[
;;; THESE NAMES SHOULD BE PHASED OUT IN FAVOR OF THE ITS-STANDARD %PI SERIES.
;;; LISP SETS ITS INTERRUPT MASK (.MASK USET VARIABLE) ONLY FROM
;;; THE CONTENTS OF LOCATION IMASK, WHICH INITIALLY CONTAINS STDMSK.
;;; DEPOSITING DBGMSK THERE BEFORE STARTUP DISABLES ALL INTERRUPTS
;;; EXCEPT TTY AND PDL OVERFLOW, SO THAT DDT WILL TRAP ILOP, MPV, ETC.
IB.ALARM==200000,, ; REAL TIME CLOCK (ALARM CLOCK)
IB.TIMER==100000,, ; RUN TIME CLOCK
IB.PARITY==1000,, ;+ PARITY ERROR
IB.FLOV==400,, ; FLOATING OVERFLOW
IB.PURE==200,, ;+ PURE PAGE TRAP (WRITE INTO READ-ONLY)
IB.PCPURE==100,, ;+ PURE INSTRUCTION FETCH FROM IMPURE
IB.SYSUUO==40,, ;+ SYS UUO TRAP
IB.AT3==20,, ; ARM TIP BREAK 3
IB.AT2==10,, ; ARM TIP BREAK 2
IB.AT1==4,, ; ARM TIP BREAK 1
IB.DEBUG==2,, ; SYSTEM BEING DEBUGGED
IB.RVIOL==1,, ;+ RESTRICTION VIOLATION (?)
IB.CLI==400000 ; CORE LINK INTERRUPT
IB.PDLOV==200000 ; PDL OVERFLOW
IB.LTPEN==100000 ; LIGHT PEN INTERRUPT
IB.MAR==40000 ;+ MAR INTERRUPT
IB.MPV==20000 ;+ MEMORY PROTECTION VIOLATION
IB.SCLK==10000 ; SLOW CLOCK TICK (.5 SEC)
IB.1PROC==4000 ;* SINGLE INSTRUCTION PROCEED
IB.BREAK==2000 ;* .BREAK EXECUTED
IB.ILAD==1000 ;+ ILLEGAL USER ADDRESS
IB.IOC==400 ;+ I/O CHANNEL ERROR
IB.VALUE==200 ;* .VALUE EXECUTED
IB.DOWN==100 ; SYSTEM GOING DOWN OR BEING REVIVED
IB.ILOP==40 ;+ ILLEGAL INSTRUCTION OPERATION
IB.DMPV==20 ;+ DISPLAY MEMORY PROTECTION VIOLATION
IB.AROV==10 ; ARITHMETIC OVERFLOW
IB.42BAD==4 ;* BAD LOCATION 42
IB.C.Z==2 ;* ↑Z TYPED WHEN THIS JOB HAD TTY
IB.TTY==1 ; INTERRUPT CHAR TYPED ON TTY
] ;END OF IFN ITS
IFN D10,[
IB.PDLOV==AP.POV ; PDL OVERFLOW
IB.MPV==AP.ILM ;+ MEMORY PROTECTION VIOLATION
SA% STDMSK==AP.REN+AP.POV+AP.ILM+AP.NXM+AP.PAR
SA$ STDMSK==<4404,,230000>
] ;END OF IFN D10
;;; ********** I/O CHANNEL ASSIGNMENTS **********
;;; PAGE 376 IS RESERVED FOR COPYING (SEE IP1), AND 377 FOR DISUSE.
;;; (THE DISUSE AS TO DO WITH AN OLD HARDWARE BUG IN BLT.)
;;; ON AI, PAGE 375 IS FOR MAPPING PAGE 0 OF THE DISPLAY SLAVE.
IT$ P6=MEMORY-3*PAGSIZ ;PAGE 0 OF PDP6 SLAVE IS MAPPED INTO PDP-10 MEMORY
] ;END OF IF1
;IFE <ITS+TENEX>*USELESS, NPGTPS==0
IFE 0, NPGTPS==0
TOPN==0
BOTN==0
.XCREF TOPN BOTN
NPURTR==0
NIOCTR==0
.XCREF PURTR1 NPURTR NIOCTR
N2DIF==0
NPRO==0+1 ;NUMBER OF INTERRUPT PROTECTION REGIONS
;NOTE DEFN OF PRO0 IN MACS FILE
.XCREF NPRO
IFN D10,[
HS$ .DECTWO HSGORG ;DEC TWO-SEGMENT RELOC OUTPUT
HS% .DECREL ;ONE SEGMENT ASSEMBLY
IFN PAGING, LOC 140 ;FOR PAGING ASSEMBLY NEED ABSOLUTE ADDRESSING
%LOSEG==-1 ;INITIALLY START IN LOW SEGMENT
%HISEG==0 ;START AT 0 RELATIVE TO HIGH SEG ORIGIN
] ;END OF IFN D10
IFN ITS, IFDEF .SBLK, .SBLK ;EVENTUALLY FLUSH "IFDEF .SBLK"
20$ .DECSAV ;FOR TOPS-20, JUST GET .EXE FILE
20$ LOC 140 ;BUT FORCE ABSOLUTE ADDRESSING
.YSTGWD ;STORAGE WORDS ARE OKAY NOW
FIRSTLOC:
IFN D10,[
HS$ HILOC==.+HSGORG ;HISEG GENERALLY STARTS AT 400000
HS% HILOC==.
;;; FOR DEC-10, FIRSTLOC AS LOADED WITH RELOCATION MUST BE
;;; STDLO+M*SEGSIZ
;;; AND SIMILARLY HILOC WHEN LOADED MUST BE
;;; STDHI+N*SEGSIZ
;;; FOR INTEGRAL M AND N. INIT WILL ENFORCE THIS IN ORDER
;;; TO PRESERVE SEGMENT BOUNDARIES CORRECTLY.
;;; CURSTD IS THE STDXX FOR WHICHEVER IS THE CURRENT SEGMENT.
STDLO==140 ;SIZE OF JOB DATA AREA
STDHI==10 ;VESTIGIAL JOB DATA AREA
CURSTD==STDLO .SEE $LOSEG
] ;END OF IFN D10
IFN PAGING,[
STDLO==0
STDHI==0
CURSTD==0
] ;END OF IFN PAGING
IFN PAGING, BZERSG==0 ;BEGINNING OF "ZERO" SEGMENT(S)
IFE PAGING, BZERSG==FIRSTLOC-STDLO
SUBTTL FIRST LOCATIONS (41, GOINIT, LISPGO); UUO AND INTERRUPT VECTORS
LOC 41
JSR UUOH ;UUO HANDLER
10X WARN [TENEX INTERRUPT VECTOR?]
LOC FIRSTLOC
GOINIT:
IFN ITS,[
.SUSET [.S40ADDR,,[TWENTY,,FORTY]] ;SET .40ADDR
IFN USELESS,[
MOVEI T,IB<MAR> ;RESET THE MAR BREAK FEATURE
ANDCAM T,IMASK
.SUSET [.SAMASK,,T]
.SUSET [.SMARA,,R70]
] ;END OF IFN USELESS
] ;END OF IFN ITS
JSR STINIT
GOINI7: SETZB A,VERRLI ;NULLIFY ERRLIST
PUSHJ P,INTERN
JUMPE A,LISPGO
PUSHJ P,REMOB2 ;GET STANDARD COPY OF NIL ON OBLIST
JRST GOINI7
STINIT: 0 ;COME HERE BY JSR
MOVEI A,READTABLE ;INITIALIZATIONS AT START-UP TIME
MOVEM A,VREADTABLE
MOVE A,[RCT0,,RCT]
BLT A,RCT+LRCT-1 ;RESTORE READ CHARACTER SYNTAX TABLE
MOVEI A,TTYIFA
MOVEM A,V%TYI
MOVEI A,TTYOFA
MOVEM A,V%TYO
MOVEI A,TRUTH
MOVEM A,VINFILE
SETZM VINSTACK
SETZM VOUTFILES
SETZM VECHOFILES
MOVEI A,QTLIST
MOVEM A,VMSGFILES
MOVEI A,OBARRAY
MOVEM A,VOBARRAY ;GET BACK TOPLEVEL OBARRAY
SETZM V%PR1
SETZM VOREAD
SETZM TLF
SETZM BLF ;??
SETZM UNRC.G ;CLEAR STACKED NOINTERRUPT STUFF
SETZM UNRRUN
SETZM UNRTIM
SETZM UNREAR
SETZM TTYOFF
IFN SAIL,[
MOVE P,C2
MOVE FXP,FXC2
] ;END OF IFN SAIL
IFN ITS,[
MOVE TT,[4400,,400000+<<PDLORG←-PAGLOG>←11>]
.CBLK TT,
.VALUE
MOVE TT,[4400,,400000+<<SPDLORG←-PAGLOG>←11>]
.CBLK TT,
.VALUE
MOVE TT,[4400,,400000+<<FXPORG←-PAGLOG>←11>]
.CBLK TT,
.VALUE
MOVE TT,[4400,,400000+<<FLPORG←-PAGLOG>←11>]
.CBLK TT,
.VALUE
] ;END OF IFN ITS
IFN D20,[
;; DECIDE BETWEEN TENEX AND TOPS20 AND SET PAGE ACCESSIBILITYS
JSP R,TNXSET
SKIPN TENEXP
SKIPN VTS20P
JRST .+7
MOVEI 1,.PRIIN
RTMOD
IOR 2,[STDTMW] ;CURRENTLY FORCES DISPLAY MODE, WRAP-AROUND
MOVEM 2,TTYIF2+TI.ST6
MOVEM 2,TTYOF2+TI.ST6
STMOD
] ;END OF IFN D20
IFN D10*<1-SAIL>, JSP T,D10SET
PISTOP
JSP A,ERINIX
JRST 2,@STINIT
;;; HERE IF NOT STOPPING AFTER A SUSPEND
SUSCON: MOVEI A,TRUTH ;RETURN T RATHER THAN NIL
MOVEM A,-1(FLP)
;;; FALL INTO LISPGO
IFN SAIL*PAGING,[
JRST LISPGO ;INTENSE CROCK FOR E/MACLISP INTERFACE!
JSP 10,E.START
] ;END OF IFN SAIL*PAGING
LISPGO:
IFN SAIL*PAGING,[
SETZM VECALLEDP
] ;END OF IFN SAIL*PAGING
SETOM AFILRD ;START HERE ON ≠G'ING
IT$ .SUSET GOL1 ;SET .40ADDR
IT$ .SUSET GOL2 ;GET INITIAL SNAME
JRST 2,@LISPSW ;ZEROS OUT PC FLAGS, AND TRANSFERS TO LISP
IT$ GOL2: .RSNAM,,IUSN ;KEEP THESE ON SAME PHYSICAL PAGE
IT$ GOL1: .S40ADDR,,.+1
IT$ TWENTY,,FORTY
LISPSW: %ALLOC ;ALLOC CLOBBERS TO BE "LISP"
SUSFLS: TRUTH ;NON-NIL MEANS FLUSH SHARABLE PAGES BEFORE SUSPENDING
KA10P: 0 ;NON-ZERO ==> KA PROCESSOR (AS OPPOSED TO KL OR KI)
IFN ITS,[
TWENTY==:20 ;VARIOUS PLACES OFFSET FROM TWENTY ARE USED BY DDT
THIRTY==:TWENTY+10 ;RECALL THAT THE LEFT HALF OF .40ADDR IS THE ".20ADDR"
;;; ADDRESSES IN THE 20 BLOCK, SWIPED FROM DDT ORDER
;;; 25 HOLDS "." DURING A USER TYPEOUT INSTRUCTION
;;; 26 CONDITIONAL BREAKPOINT INSTRUCTION
;;; 27-30 .BREAK 16,'S FOR RETURNING FROM 26
;;; 31 INSTRUCTION FOR BREAKPOINT WHICH DIDN'T BREAK
;;; 32-33 JRST'S TO PROGRAM FROM 31, OR DATA FOR INSTRUCTION IN 31
;;; 34 INSTRUCTION BEING ≠X'D
.SEE MEMERR
.SEE UUOGL2
;;; 35-36 .BREAK 16,'S FOR RETURNING FROM 34
.SEE $XLOST
.SEE UUOGL2
;;; 37 HOLDS ≠Q DURING A USER TYPEOUT INSTRUCTION
.SEE PSYM1
FORTY: 0 ;.40ADDR USER VARIABLE POINTS HERE
JSR UUOGLEEP ;SYSTEMIC UUO HANDLER
-LINTVEC,,INTVEC ;SYSTEMIC INTERRUPT HANDLER
;;; THAT'S SYSTEMIC, NOT NECESSARILY SYSTEMATIC!!!
;;; ITS PASSES THE BUCK TO THE USER ON UUO'S 0 AND 50-77.
;;; THEY TRAP THROUGH THE .40ADDR, NOT NECESSARILY 40;
;;; SINCE LISP TREATS THESE AS ERRORS, WE CAN AFFORD TO SAVE
;;; THE JPC AND OTHER GOODIES HERE.
UUOGLEEP: 0
.SUSET [.RJPC,,JPCSAV]
JRST UUOGL1
] ;END OF IFN ITS
JPCSAV: 0
SUBTTL SFX HACKERY
;;; SFX MACRO TELLS WHERE A LONG PIECE OF SEMI-CRITICAL (MAY BE QUIT
;;; OUT OF, BUT MUST NOT PERMIT USER INTERRUPTS IN) CODE MAY BE MUNGED
;;; IF INTERRUPTED IN THE MIDDLE SO THAT WHEN DONE IT WILL RETURN TO
;;; THE INTERRUPT HANDLER. SUCH CODE INCLUDES ARRAY SUBSCRIPT
;;; COMPUTATIONS (SINCE AN INTERRUPT COULD DISPLACE THE ARRAY)
;;; AND ALL CODE WHICH MODIFIES THE SPECIAL PDL.
NSFC==0 ;COUNTER FOR MACRO SFX
.XCREF NSFC
IFE PAGING,[
DEFINE SFX A/
SFSTO \.-FIRSTLOC,\NSFC,[A]
NSFC==NSFC+1
A
TERMIN
DEFINE SFSTO PT,NM,IN
DEFINE ZZM!NM
FIRSTLOC+PT
TERMIN
DEFINE ZZN!NM
IN
TERMIN
TERMIN
] ;END OF IFN PAGING
IFN PAGING,[
DEFINE SFX A/
SFSTO \.,\NSFC,[A]
NSFC==NSFC+1
A
TERMIN
DEFINE SFSTO PT,NM,IN
DEFINE ZZM!NM
PT
TERMIN
DEFINE ZZN!NM
IN
TERMIN
TERMIN
] ;END OF IFN PAGING
;;; THE ZZM AND ZZN MACROS ARE EXPANDED AT SFXTBL (Q.V.)
;;; **** ALL USES OF THE SFX MACRO MUST APPEAR ON THIS PAGE ****
SFXPRO
10$ UNBD2A:
10$ POP FXP,R ;Restore R
UNBND2: MOVE TT,(SP)
MOVEM TT,SPSV ;ABOUT LOADING TT WITH SPSV, SEE UNBIND
MOVE TT,UNBND3
SFX POPJ P,
ABIND3: PUSH SP,SPSV
SFX POPJ P,
SETXIT: SUB SP,R70+1
SFX JRST (T)
SPECX: PUSH SP,SPSV
SFX JRST (T)
AYNVSFX: ;XCT'ED BY AYNVER
SFX %WTA (D)
1DIMS: JSP T,AYNV1 ;1-DIM S-EXP ARRAYS COME HERE
ARYGET: ROT R,-1 ;COMMON S-EXP ARRAY ACCESS ROUTINE
ADDI TT,(R)
ARYGT4: JUMPL R,ARYGT8
HLRZ A,(TT)
SFX POPJ P,
ARYGT8: HRRZ A,(TT)
SFX POPJ P,
1DIMF: JSP T,AYNV1 ;1-DIM FULLWORD ARRAYS COME HERE
ANYGET: ADDI TT,(R) ;COMMON FULLWORD ARRAY ACCESS ROUTINE
MOVE TT,(TT)
SFX POPJ P,
IFN DBFLAG+CXFLAG,[
1DIMD: JSP T,AYNV1 ;1-DIM DOUBLEWORD ARRAYS COME HERE
ADYGET: LSH R,1 ;COMMON DOUBLEWORD ARRAY ACCESS ROUTINE
ADDI TT,(R)
KA MOVE D,1(TT)
KA MOVE TT,(TT)
KIKL DMOVE TT,(TT)
SFX POPJ P,
] ;END OF IFN DBFLAG+CXFLAG
IFN DXFLAG,[
1DIMZ: JSP T,AYNV1 ;1-DIM FOUR-WORD ARRAYS COME HERE
AZYGET: LSH R,2 ;COMMON FOUR-WORD ARRAY ACCESS ROUTINE
ADDI TT,(R)
KA MOVE R,(TT)
KA MOVE F,1(TT)
KA MOVE D,3(TT)
KA MOVE TT,2(TT)
KIKL DMOVE R,(TT)
KIKL DMOVE TT,2(TT)
SFX POPJ P,
] ;END OF IFN DXFLAG
NOPRO
SPSV: 0 ;IMPORTANT TO SPECPDL BINDINGS
.SEE $IWAIT
;;; **** THERE MUST BE NO MORE USES OF THE MACRO SFX BEYOND HERE ****
EXPUNGE SFX SFSTO
SUBTTL INTERRUPT FLAGS AND VARIABLES
;;; INTFLG INDICATES WHETHER IN INTERRUPT IS PENDING:
;;; 0 => NO INTERRUPT
;;; -1 => USER INTERRUPT PENDING (STACKED IN INTAR)
;;; -2 => ↑X QUIT PENDING, DON'T RESET TTY
;;; -3 => ↑G QUIT PENDING, DON'T RESET TTY
;;; -6 => ↑X QUIT PENDING, DO RESET TTY
;;; -7 => ↑G QUIT PENDING, DO RESET TTY
INTFLG: 0
;;; MAY NOT ↑G/↑X QUIT OR ALLOW USER INTERRUPTS IF NOQUIT NON-ZERO
;;; NON-ZERO IN LH MEANS GC IN PROGRESS; IMPLIES
;;; PDL POINTERS AND NIL MAY BE CLOBBERED
;;; NON-ZERO ONLY IN RH MEANS PDL POINTERS AND NIL ARE OK
NOQUIT: 0
;;; MAY NOT ALLOW "REAL TIME" INTERRUPTS (CLOCK AND TTY) WHEN
;;; UNREAL IS NON-ZERO. MUNGED BY THE FUNCTION NOINTERRUPT.
;;; 0 => ALL INTERRUPTS OKAY
;;; -1 => NO INTERRUPTS OKAY
;;; 'TTY => ALARMCLOCK OKAY, TTY NOT OKAY
UNREAL: 0
REALLY: 0 ;IF NON-ZERO, THE ADDRESS OF A PDL SLOT FOR THE
;UNBINDER TO UNBIND A SAVED UNREAL INTO.
;SO THAT UNWPR1 CAN KEEP UNREAL SET WHILE BINDING IT.
.SEE WIOUNB
.SEE UNWPR1
ERRSVD: 0 .SEE ERRBAD
;;; INTERRUPT MASK IS ALWAYS INITIALIZED FROM THIS WORD.
;;; FOR ITS, THIS IS THE .MASK (AND .MSK2) WORDS.
;;; FOR TOPS10 AND CMU, THIS IS THE APRENB WORD.
;;; FOR D20, THIS IS THE CHANNEL ENABLE WORD
;;; DEPOSITING DBGMSK INTO IT BEFORE STARTUP CAN AID DEBUGGING.
;;; FOR ITS AND D20, IMPURE LISPS WILL HAVE DEBUG MASKS IN THESE
;;; LOCATIONS; THE PURIFY ROUTINE INSTALLS THE STANDARD MASKS.
.SEE PURIFY
.SEE DBGMSK
IFN D10\D20, OIMASK: 0 ;HOLDS OLD INT MASK WHEN INTS ARE DISABLED
10% INTMSK:
IMASK: STDMSK ;INTERRUPT MASK WORD
IT$ IMASK2: STDMS2 ;ITS HAS TWO INTERRUPT MASKS
LFAKP==5 ;MUST BE LONG ENOUGH FOR USES BY
LFAKFXP==6 ; PDLOV, ERINIT, AND PURIFY
FAKP: BLOCK LFAKP ;FAKE REGPDL, FOR USE BY PDLOV AND ERINIT
FAKFXP: BLOCK LFAKFXP ;FAKE FIXPDL, FOR USE BY PDLOV AND ERINIT
IT$ VALFIX: 0 ;-1 --> VALRET 'STRING' IS REALLY A FIXNUM
IT$ .SEE VALSTR
IFN D10,[
CMUP: 0 ;CMU MONITOR?
IFE SAIL,[
MONL6P: 0 ;6-LEVEL MONITOR OR BETTERP?
] ;END OF IFE SAIL
] ;END OF IFN D10
;;; IF NON-ZERO, THIS CONTAINS THE ADDRESS OF A USER-SUPPLIED
;;; INTERRUPT PROCESSOR. THE LISP SYSTEM INTERRUPT HANDLER
;;; WILL GIVE IT ANY INTERRUPT LISP DOESN'T PROCESS ITSELF. SEE INT0.
UPIINT: 0
IFN D20,[
;;; TOPS-20 INTERRUPT VARIABLES
;;; FLAGS SETUP BY ALLOC AND SUSPEND
CCOCW1: CCOC1 ;This words may be "remodeled" at allocation time, and at
CCOCW2: CCOC2 ; start-up from suspension, to account for 10X/20X differences
TENEXP: 0 ;Also set up as above
VTS20P: 0 ;Non-0 if system has the Virtual Terminal Support
;;; BLOCK OF THREE LOCATIONS IN WHICH THE PC IS STORED ON AN INTERRUPT.
;;; ONE LOCATION FOR EACH OF TOPS-20'S THREE LEVELS
INTPC1: 0
INTPC2: 0
INTPC3: 0
;;; TEMPORARY LOCATIONS USED BY INTERRUPT HANDLERS
PDLSVT: 0 ;USED BY $PDLOV TO SAVE AC T WHILE MUNGING THE INTPDL
SUPSAV: 0 ;USED BY INTSUP
LV2SVT: 0 ;LEVEL 2 PARAMETERS: SAVE T
LV2SVF: 0 ; SAVE F
LV2ST2: 0 ; SECOND SAVE T
LV3SVT: 0 ;LEVEL 3 PARAMETERS: SAVE T
LV3SVF: 0 ; SAVE F
LV3ST2: 0 ; SECOND SAVE T
DSMSAV: . ;POINTER INTO SMALL STACK USED BY DSMINT
BLOCK 10 ;TO BE SAFE, BUT 4 SHOULD BE MAXIMUM DEPTH
IT% CN.ZX: 0 ;WHERE TO EXIT AFTER ↑Z
;;; AS TTY INTERRUPT CHANNEL MUST BE DYNAMICALLY ALLOCATED, AND THERE ARE
;;; FEWER CHANNELS THAN THE TOTAL POSSIBLE NUMBER OF INTERRUPT CHARACTERS,
;;; A TABLE IS USED TO STORE THE INFORMATION. THE TABLE IS 18. WORDS LONG.
;;; A ZERO ENTRY IS UNUSED, NONZERO HAS INTERRUPT CHARACTER. IF THE TABLE
;;; ENTRY IS NEGATIVE, THEN THE CHANNEL IS ASSIGNED FOR SOME OTHER USE.
;CHANNEL ASSIGNMENTS FOR NON-STANDARD(?) INTERRUPTS
CINTAB:
TICMAP .TIC!CODE
REPEAT 18.-<.-CINTAB>, 0 ;INITIALLY UNUSED
CINTSZ==.-CINTAB
] ;END IFN D20
SUBTTL DEFINITIONS OF TTY STATUS WORDS
IFN ITS,[
;;; INITIAL TTY STATUS IS AS FOLLOWS:
;;; ACTIVATION CHARS:
;;; ↑@-↑L, ↑N-↑Z, ↑\-↑←, SPACE, < > ( ) { } RUBOUT CR
;;; LBRACKET RBRACKET
;;; INTERRUPT CHARS:
;;; ↑@-↑H, ↑K, ↑L, ↑N-↑Z, ↑\-↑←, SPACE
;;; ↑H AND SPACE DO NOT INTERRUPT
;;; SPACE AND BACKSPACE OUTPUT IN IMAGE MODE, ALL OTHERS IN ASCII.
;;; ALL CHARS ECHO IN PI MODE (ECHO WHEN TYPED), EXCEPT RUBOUT DOESN'T ECHO.
;;;
;;; RECALL THAT THE TWELVE CHARACTER GROUPS ARE:
;;; ↑@ ↑A-↑F ↑K-↑L ↑N-↑R ↑T-↑Z ↑RBRACKET ↑\ ↑↑ ↑←
;;; A-Z (UPPER CASE), a-z (LOWER CASE)
;;; 0-9
;;; ! " # $ % & ' , . : ; ? @ \ ` | }
;;; * + - / = ↑ ←
;;; < > ( ) { } LBRACKET RBRACKET
;;; ↑G ↑S
;;; ↑J ↑I
;;; ALTMODE
;;; ↑M
;;; RUBOUT
;;; SPACE ↑H
.SEE %TG
STTYW1==:232020,,202022 ;STATUS WORDS FOR NORMAL MODE
STTYW2==:232220,,220232
STTYL1==:232020,,202020 ;STATUS WORDS FOR LINE MODE
STTYL2==:212020,,220222
STTYA1==:022222,,222222 ;STATUS WORDS FOR ALLOC
STTYA2==:320222,,020222
] ;END OF IFN ITS
IFN D20,[
;;; Control-Character-Output-Control - two bits for each control character
;;; 0 - ignore,
;;; 1 - print ↑X,
;;; 2 - output unmodified,
;;; 3 - simulate format action
RADIX 4
CCOC1==:111111123321131111
CCOC2==:111111111311110000
RADIX 8
; SEE CCOCW1 AND CCOCW1
;;; Four classes of wake-up control
XACTW==:TT%WKF+TT%WKN+TT%WKP+TT%WKA ;FULL WAKE UPS
XACTL==:TT%WKF ;WAKE UPS FOR "LINEMODE"
STDJMW==XACTW+TT%ECO+<.TTASC←6> .SEE TT%DAM
;STANDARD JFN MODE WORD FOR TERMINAL
STDTMW==TM%DPY ;STANDARD TERMINAL MODE WORD, FOR VTS STUFF
STDTIW==0 ;STANDARD TERMINAL INTERRUPT WORD - not really used!
TICMAP {STDTIW==STDTIW+<1←<35-.TIC!CODE>>}
] ;END OF IFN D20
IFN SAIL,[
SACTW1==:777777777370
SACTW2==:030000005000
SACTW3==:000000240000
SACTW4==:000005200000
SACTL1==:775177577370
SACTL2==:000000000000
SACTL3==:000000000000
SACTL4==:000000200000
] ;END OF IFN SAIL
SUBTTL ENTRIES TO VARIOUS ROUTINES CALLED BY JSR
UISTAK: 0 ;STACK UP (ACTUALLY, QUEUE) A USER INTTERRUPT
JRST UISTK1
GCRSR: 0 ;GC RESTORE. CLEANS UP JUST BEFORE AN
JRST GCRSR0 ; ABNORMAL EXIT (GCEND IS NORMAL EXIT).
IFN PAGING,[
PDLSTH: 0 ;"PDL ST HACK". GETS A NEW PAGE FOR A PDL,
JRST PDLST0 ; AND UPDATES ST AND GCST APPROPRIATELY.
IFN D20,[
PDLSTA: 0 ;TEMPS FOR SAVING ACS
PDLSTB: 0
PDLSTC: 0
] ;END OF IFN D20
] ;END OF IFN PAGING
SUBTTL NEWIO I/O CHANNEL ALLOCATION TABLE
;;; ENTRIES:
;;; 4.9 => CHANNEL IS LOCKED FOR A PARTICULAR PURPOSE
;;; 1.1-2.9 => ADDRESS OF FILE ARRAY SAR
;;; IF AN ENTRY IS NON-ZERO BUT ITS FILE ARRAY SAR'S
;;; TTS.CL BIT IS SET, THE CHANNEL MAY BE DE-ALLOCATED.
;;; THIS ORDINARILY HAPPENS ONLY ON A QUIT OUT OF $OPEN.
;;; CHANNEL 0 (TMPC) IS PERMANENTLY LOCKED FOR USE OF THE ERR
;;; DEVICE, FOR UPROBE, ETC. NOTE THAT ITS PUTS .OPEN
;;; AND .CALL FAILURE CODES ON CHANNEL 0 ARBITRARILY.
IFN ITS+D10, LCHNTB==:20 ;NUMBER FIXED BY OPERATING SYSTEM
IFN D20, MAYBE LCHNTB==:40 ;THIS NUMBER IS BASICALLY ARBITRARY
CHNTB:
OFFSET -.
TMPC:: 400000,,NIL ;FIXED TEMPORARY CHANNEL
IFGE LCHNTB-., BLOCK LCHNTB-.
.ELSE WARN [TOO MANY FIXED I/O CHANNELS]
OFFSET 0
;;; DEC-10 I/O BUFFER HEADERS (MUST REMAIN FIXED IN CORE)
;;; THEY ARE NAMED BFHD0, BFHD1, ..., BFHD17.
IFN D10, REPEAT LCHNTB, CONC BFHD,\.RPCNT,: BLOCK 3
DPAGEL: 60. ;INITIAL DEFAULT PAGEL
DLINEL: 70. ;INITIAL DEFAULT LINEL
IFN JOBQIO,[
LJOBTB==10 ;EIGHT INFERIOR PROCEDURES
JOBTB: BLOCK LJOBTB
] ;END OF IFN JOBQIO
SUBTTL INITIAL TTY INPUT FILE ARRAY
-F.GC,,TTYIF2 ;GC AOBJN POINTER
TTYIF1: JSP TT,1DIMS
TTYIFA ;POINTER BACK TO SAR
0 ;ILLEGAL FOR USER TO ACCESS - DIMENSION IS ZERO
TTYIF2:
OFFSET -.
FI.EOF:: NIL ;EOF FUNCTION (??)
FI.BBC:: 0,,NIL ;BUFFERED BACK CHARS
FI.BBF:: NIL ;BUFFERED BACK FORMS
TI.BFN:: QTTYBUF ;PRE-SCAN FUNCTION
FT.CNS:: TTYOFA ;ASSOCIATED TTY OUTPUT FILE
REPEAT 3, 0 ;UNUSED SLOTS
F.MODE:: SA% FBT.CM,,2 ;MODE (ASCII TTY IN SINGLE)
SA$ FBT.CM\FBT.LN,,2
F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
20$ F.JFN:: .PRIIN ;JFN (FOR D20 ONLY)
20% 0
F.FLEN:: -1 ;WE EXPECT RANDOM ACCESS TO BE ILLEGAL
F.FPOS:: 0 ;FILE POSITION
REPEAT 3, 0 ;UNUSED SLOTS
IFN ITS+D10,[
F.DEV:: SIXBIT \TTY\ ;DEVICE
IT$ F.SNM:: 0 ;SNAME (FILLED IN)
10$ F.PPN:: 0 ;PPN (FILLED IN)
F.FN1::
IT$ SIXBIT \.LISP.\ ;FILE NAME 1
10$ SIXBIT \LISP\
F.FN2::
IT$ SIXBIT \INPUT\ ;FILE NAME 2
10$ SIXBIT \IN\
F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
] ;END OF IFN ITS+D10
IFN D20,[
F.DEV:: ASCII \TTY\
] ;END OF IFN D20
LOC TTYIF2+LOPOFA
NTI.WDS==6 ;HOW MANY OF THESE TTY-INPUT WDS?
IFN ITS+D20+SAIL,[
TI.ST1::
IT$ STTYW1 ;TTY STATUS WORDS
20$ CCOC1 ;"REMODELED" AT TXNSET time
SA$ SACTW1
TI.ST2::
IT$ STTYW2
20$ CCOC2 ;"REMODELED" AT TXNSET time
SA$ SACTW2
TI.ST3::
IT$ 0 ;TTY ACTIVATION-CHARACTER WORDS
20$ STDJMW ; (EXCEPT ON ITS -- USUSED THERE)
SA$ SACTW3 ; TWENEX JFN-MODE WORD FOR TTY
TI.ST4::
IT$ 0
20$ STDTIW
SA$ SACTW4
TI.ST5:: 0 ;TTYOPT WORD (STORED IN ITS FORMAT,
; ALTHOUGH READ FROM D20 BY RTCHR
TI.ST6::
20$ STDTMW ;TERMINAL MODE WORD (D20 ONLY)
20% 0
TBLCHK TI.ST1,NTI.WDS
] ;END OF IFN ITS+D20+SAIL
.ELSE BLOCK NTI.WDS
LOC TTYIF2+FB.BUF
FB.BUF:: ;INTERRUPT FUNCTIONS
IFE SAIL,[
NIL,,IN0+↑A ;↑@ ↑A "SIGNAL" ON
IT% QCN.BB,,NIL ;↑B ↑B-BREAK ↑C
IT$ QCN.BB,,IN0+↑C ;↑B ↑B-BREAK ↑C GC STAT OFF
IN0+↑D,,NIL ;↑D GC STAT ON ↑E
NIL,,IN0+↑G ;↑F ↑G HARD QUIT
REPEAT 3, NIL,,NIL ;↑H-↑M (FORMAT EFFECTORS)
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IFE D20,[
IT$ IN0+↑R,,IN0+↑W ;↑R UWRITE ON? ↑S ↑W INT, ↑V MACRO
IT% IN0+↑R,,NIL ;↑R UWRITE ON? ↑S
IN0+↑T,,NIL ;↑T UWRITE OFF? ↑U
] ;END OF IFE D20
IFN D20,[
NIL,,NIL ;↑R ↑S
NIL,,NIL ;↑T ↑U
] ;END OF IFE D20
IN0+↑V,,IN0+↑W ;↑V TTY ON ↑W TTY OFF
IN0+↑X,,NIL ;↑X SOFT QUIT ↑Y
IN0+↑Z,,NIL ;↑Z GO TO DDT ≠ <ALTMODE>
NIL,,NIL ;↑\ CONTROL RIGHT-BRACKET
NIL,,NIL ;↑↑ ↑←
REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL ;ALL OTHERS INITIALLY UNUSED
] ;END IFE SAIL
IFN SAIL,[
REPEAT 100, NIL,,NIL ;ALPHABETIC (ASCII 0 THROUGH ASCII 177)
REPEAT 40, NIL,,NIL ;LOW CONTROL ↑<NULL> UP TO ↑@ (200-277)
NIL,,IN0+↑A ; ↑A
QCN.BB,,IN0+↑C ;↑B ↑C
IN0+↑D,,NIL ;↑D
NIL,,IN0+↑G ;↑F ↑G
REPEAT 3, NIL,,NIL
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IN0+↑R,,IN0+↑W ;↑R ↑S
IN0+↑T,,NIL ;↑T
IN0+↑V,,IN0+↑W ;↑V ↑W
IN0+↑X,,NIL ;↑X ↑Y
IN0+↑Z,,NIL ;↑Z
REPEAT 3, NIL,,NIL
QCN.BB,,NIL
NIL,,NIL
NIL,,IN0+↑G ;LOWERCASE ↑G
REPEAT 11, NIL,,NIL
IN0+↑Z,,NIL
REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL
] ;END IFN SAIL
OFFSET 0
SUBTTL INITIAL TTY OUTPUT FILE ARRAY
-F.GC,,TTYOF2 ;GC AOBJN POINTER
TTYOF1: JSP TT,1DIMS
TTYOFA ;POINTER BACK TO SAR
0 ;USER MAY NOT ACCESS, SO SAY DIMENSION IS ZERO
TTYOF2:
OFFSET -.
FO.EOP:: QTTYMOR ;END OF PAGE FUNCTION
REPEAT 3, 0
FT.CNS:: TTYIFA ;STATUS TTYCONS
REPEAT 3, 0
F.MODE:: FBT.CM,,3 ;MODE (ASCII TTY OUT SINGLE)
F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
20$ F.JFN:: .PRIOU ;JFN
20% 0
F.FLEN:: -1 ;NOT RANDOMLY ACCESSIBLE
F.FPOS:: 0 ;FILE POSITION
REPEAT 3, 0
IFN ITS+D10,[
F.DEV:: SIXBIT \TTY\ ;DEVICE
IT$ F.SNM:: 0 ;SNAME (FILLED IN)
10$ F.PPN:: 0 ;PPN (FILLED IN)
F.FN1::
IT$ SIXBIT \.LISP.\ ;FILE NAME 1
10$ SIXBIT \LISP\
F.FN2::
IT$ SIXBIT \OUTPUT\ ;FILE NAME 2
10$ SIXBIT \OUT\
F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
] ;END OF IFN ITS+D10
IFN D20,[
F.DEV:: ASCII \TTY\
] ;END OF IFN D20
LOC TTYOF2+LOPOFA
BLOCK 6
ATO.LC:: 0 ;LINEFEED/SLASH FLAG
AT.CHS:: 0 ;CHARPOS
AT.LNN:: 0 ;LINENUM
AT.PGN:: 0 ;PAGENUM
FO.LNL:: 71. ;LINEL
FO.PGL:: 200000,, ;PAGEL
FO.RPL:: 24. ;"REAL" PAGEL
OFFSET 0
BLOCK <LOPOFA+LONBFA>-<.-TTYOF2>
SUBTTL SUPER-WRITABLE STUFF - MUST BE SAVED UPON USER INTERRUPT
;;; DONT ALLOW USER INTERRUPTS WHILE:
;;; (1) NOQUIT IS NON-ZERO - THIS PROTECTS GC,
;;; RETSP, SUBLIS, AND OTHERS.
;;; (2) INHIBIT IS NON-ZERO - THIS PROTECTS
;;; MANY AREAS OF SEMI-CRITICAL CODE.
;;; (CF. LOCKI AND UNLOCKI MACROS)
;;; (3) UNREAL IS NON-ZERO (DEPENDS ON EXACT VALUE)
;;; - THIS IS FOR THE NOINTERRUPT FUNCTION
SWS::
;;; THE FOLLOWING STUFF IS SAVED WHEN AN "ERRSET FRAME" IS CREATED.
;;; NOT ONLY ERRSET, BUT ALSO CATCH AND READ NEED TO DO THIS.
;;; INTERPRETED PROGS CREATE A SORT OF HALF-ASSED FRAME.
;;; BEWARE! THE COMPILER DEPENDS ON KNOWING THE LENGTH OF
;;; THE ERRSET FRAME AS A CONSTANT PARAMETER.
ERRTN: 0 ;PDL RESTORATION FOR ERRSET
CATRTN: 0 ;PDL RESTORATION FOR CATCH OF A THROW
EOFRTN: 0 ;PDL RESTORATION ON E-O-F TRAPOUT
PA4: 0 ;PDL RESTORATION ON GO OR RETURN
INHIBIT: 0 ;NON-ZERO => INHIBIT (DELAY) ALL USER INTERRUPTS
; -1,,0 => INHIBIT ALL EXCEPT TTY INTERRUPTS
ERRSW: -1 ;0 MEANS NO PRINT ON ERROR DURING ERRSET
; ACTUALLY, "UNREAL" IS STORED IN THE LH OF THIS WORD
; WHEN AND "ERRSET-PUSHED" BLOCK IS PUSHED.
BFPRDP: 0 ;LH: FUNCTION WHICH WANTS TTY PRE-SCAN
; (READ, READLINE)
; TYI FOR ACTIVATION AND CURSORPOS
; CLEVERNESS, BUT NO PRE-SCAN
; NIL FOR NO CLEVERNESS AT ALL
;RH: -1 IF WITHIN READ
CATID: NIL ;RH: CATCH IDENTIFICATION TAG
;LH: FLAGS INDICATING SUBTYPE OF FRAME
CATSPC==400000 ; SPECIAL PROCESSING NEED BE DONE (OTHER BITS HAVE
; MEANING)
CATLIS==200000 ; C(RH) IS POINTER TO A LIST OF CATCH TAGS
CATUWP==100000 ; UNWIND-PROTECT, C(RH) IS FUNCTION
CATCAB==040000 ; CATCH-BARRIER: RH POINTER TO (CONS FUN CATCH-TAGS)
CATALL==020000 ; CATCH-ALL: RH IS FUNCTION OF TWO ARGS
CATCOM==010000 ; FROM COMPILED CODE, DO CALLF, NOT IPROGN
LEP1==.-ERRTN ;***** LENGTH OF SOME OF ERRSET PUSH
KMPLOSES==-<.-ERRSW-1>
.SEE ERSTP
UIRTN: 0 ;NON-ZERO => PDL LOC OF MOST RECENT USER INT FRAME
.SEE UINT0
RSXTB: (A) ;POINTER TO READ SYNTAX TABLE, INDEXED BY A
PNMK1: 0 .SEE PDLNMK ;SAVE TT
GCD.A: .SEE GCDBB
UNBND3: .SEE UNBIND ;SAVE TT
SIXMK2: 0 .SEE SIXMAK
SAVMAR: .SEE SUSP14 ;NEEDN'T BE IN SWS, BUT WHO CARES?
GCD.B: .SEE GCDBB
AUNBD: .SEE AUNBIND ;SAVES D FOR AUNBIND
EXP.S: .SEE EXP ;REMEMBERS SIGN OF ARG
ATAN.S: .SEE ATAN ;SAVES SIGNS OF ARGS <X,,Y>
UNMTMP: ;UNAME TEMP
FPTEM: ;PSYM WANTS THIS TO BE SAME AS PCNT!!!
IFLT9: .SEE IFLOAT ;D SAVED HERE
EQLP: 0 ;PDL POINTER UPON ENTRY TO EQUAL
.SEE EQUAL
GCD.C: .SEE GCDBB
ATAN.X: .SEE ATAN ;TEMPORARY X VALUE
GWDCNT: 0
GCD.D: .SEE GCDBB
ATAN.Y: .SEE ATAN ;TEMPORARY Y VALUE
GWDORG: 0 ;ORIGIN OF LAPPIFICATION - GWDRG1 IS GWDORG-1
GWDRG1: 0
EXPL5: 0 ;TEMP FOR EXPLODE
GCD.UH: .SEE GCDBB
BKTRP: .SEE BAKTRACE
EV0B: .SEE EVAL
FLAT1: .SEE FLATSIZE
MEMV: 0 .SEE MEMBER
UAPOS: ;-1=> UWRITE, >=0 => UAPPEND .ACCESS POS
GCD.VH: .SEE GCDBB
LPNF: ;-1 MEANS NOT A LONG PNAME (FITS IN PNBUF)
.SEE RINTERN
AUNBR: 0 ;SAVES R FOR AUNBIND
DLTC: 0 ;# OF TIMES DELETE/DELQ SHOULD REMOVE ITEM
.SEE DELQ
RINF:
APFNG1:
TABLU1: 0
AUNBF: ;SAVES F FOR AUNBIND
IFE BIGNUM,[
MNMX0: ;"MIN" INSTRUCTION
GRESS0: 0 ;"GREATERP" INSTRUCTION
] ;END OF IFE BIGNUM
IFN BIGNUM,[
GRESS0: 0 ;"MIN" AND"GREATERP" INSTRUCTION
CFAIL: JRST . ;TRANSFER ON FAILURE
CSUCE: JRST . ;TRANSFER ON SUCCEED
] ;END OF IFN BIGNUM
IT$ IOST: .STATUS 00,A
IFN ITS, SYSCL8:
BACTYF: 0 ;ZERO ON FIRST LOOP THROUGH BACTRACE.
BOOLI: SETZB D,TT ;BOOLEAN INSTRUCTION FOR BOOLE
TOPAST: -1 ;IF -1 THEN TOP-LEVEL ASTERISK NOT PRINTED IF VINFILE
; IS INIIFA
IFN USELESS, PRINLV: ;<CURRENT PRINT LEVEL>-1
PLUS0: 0 ;TYPE - QFIXNUM OR QFLONUM
IFE BIGNUM,[
PLUS3: ADD D,TT
PLUS6: FAD D,TT ;FLOAT-POINT INSTRUCTION FOR ARITH GENERATOR
] ;END OF IFE BIGNUM
IFN USELESS, ABBRSW: ;KIND OF STUFF DESIRED FROM PRINT0:
; - => ONLY ABBREV STUFF
; 0 => ONLY NON-ABBREV STUFF
; + => BOTH (DISTINGUISHED BY TYOSW)
PLUS8: 0 ;<N,,N> WHERE THERE ARE N ARGS
RM4: 0
IFN USELESS, PRPRCT: ;PRINT'S PARENS COUNTS (LEFT,,RIGHT)
SWNACK: 0 ;USED FOR WNA CHECKING IN STATUS
JRST STAT1
IFN USELESS, TYOSW: 0 ;NORMALLY ZERO - TELLS TYO TYPE OF CHAR
; + => CHAR IS FOR FILES ONLY
; - => CHAR IS FOR TTY ONLY
; 0 => CHAR IS FOR BOTH FILES AND TTY
RDBKC: 0 ;SAVED BREAK CHARACTER, ON EXIT FROM RDCHAR
RDNSV: 0 ;SAVED NUMBER (BEFORE DECIMAL-OR-NOT IS DECIDED)
RDDSV: 0 ;SAVED VALUE OF # OF DIGITS TO RIGHT OF DECIMAL POINT
RDIBS: 0 ;NUMERIC IBASE DURING READING
IFN USELESS, RDROMP: 0 ;ROMANP - ARE ROMAN NUMERALS OK?
RDINCH: 0 ;SOURCE OF CHARACTERS FOR READ
CORBP: 0 ;BYTE-POINTER FOR READ-SOURCE WHEN SOURCE IS BLOCK OF
;ASCII OR SIXBIT STUFF IN CORE
MKNCH: 0 ;INSTRUCTIION FOR MAKNAM TO GET NEXT BYTE
;;; THE PNAME BUFFER IS USED FOR VARIOUS AND SUNDRY PURPOSES.
;;; THE PRIMARY PURPOSE IS ACCUMULATING PRINT NAMES OF ATOMS.
.SEE RINTERN
;;; IT IS ALSO USED FOR VALRET AND SUSPEND STRINGS,
.SEE VALRET
.SEE SUSPEND
;;; JCL, NAMESTRINGS OF FILES (ESPECIALLY FOR D20 GTJFN JSYS),
.SEE 6BTNS
;;; ERROR MESSAGE STRING PROCESSING,
.SEE ERRIOJ
;;; AND SO ON. FOR SOME PURPOSES THIS BUFFER OVERLAPS THE BIGNUM TEMPS.
20% MAYBE LPNBUF==:10
20$ MAYBE LPNBUF==:50
PNBP: 440700,,PNBUF ;BYTE POINTER FOR PNAME BUFFER
PNBUF: BLOCK LPNBUF
0 ;EXTRA WORD USED TO GUARANTEE THAT A STRING CAN BE MADE ASCIZ
JCLBF==:PNBUF+1 ;SINCE STATUS JCL MAY CALL INTERN ON A SCO
ATMBF==:PNBUF+1 ;DITTO INTERACTION BETWEEN PRINTA AND EXPLODE
IFN BIGNUM,[
REMFL: 0 ;REMAINDER FLAG
VETBL0: 0 ;DIVISION STUFF
DVS1: 0
DVS2: 0
DVSL: 0
DD1: 0
DD2: 0
DD3: 0
DDL: 0
NORMF: 0
QHAT: 0
BNMSV: 0
FACF: 0
FACD: 0
AGDBT: 0
YAGDBT: 0
TSAVE: 0
DSAVE: 0
RSAVE: 0
FSAVE: 0
NRD10FL: 0 ;NOT READING IN BASE 10. FLAG
] ;END OF IFN BIGNUM
IFG JCLBF+24-., BLOCK JCLBF+24-. ;MUST HAVE AT LEAST 24 WDS
LJCLBF==:.-JCLBF
UUOH: ;KEEP THIS UUO STUFF CONTIGIOUS SO THAT GC CAN SAVE IT.
ERROR: 0
JRST UUOH0
ERBDF: ;SOME RANDOM TEMP FOR UUO HANDLER
UUOFN: 0 ;POINTER TO FUNCTION DURING THE UUOH1 LOOP
UUTSV: 0
UUTTSV: 0
UURSV: 0
UUALT9: .SEE UUALT ;DOESN'T CONFLICT WITH UUPSV
UUPSV: 0
UUOBKG: 0 ;IF IN *RSET MODE, PUT STUFF ON PDL
LUUSV==:.-UUOH ;STUFF THAT NEEDS SAVING FOR THE UUO HANDLER
LSWS==:.-SWS ;TOTAL LENGTH OF SUPER-WRITABLE STUFF
JRST UUBKG1
;;; ******** STUFF SAVED UPON USER INTERRUPT ENDS HERE ********
SUBTTL FREE STORAGE LISTS, AND GC AND ALLOC PARAMETERS
;;; ********** FREE STORAGE LISTS **********
;;; THESE ARE USED BY THE VARIOUS CONSERS TO ALLOCATE CELLS OF
;;; THE VARIOUS FREE STORAGE SPACES. NEVER PUT ONE OF THESE IN
;;; A MARKABLE AC (EXCEPT WITHIN A PROPERLY PROTECTED CONSER)!
;;; CAUTION! MUST PRESERVE RELATIVE ORDERING OF
;;; FFS,FFX,FFL,FFD,FFC,FFZ,FFB,FFY,FFH,FFA,FFY2
.SEE GC ;GARBAGE COLLECTOR
FFS: 0 ;LIST FREE STORAGE LIST
FFX: 0 ;FIXNUMS (AND PNAME AND BIGNUM WORDS)
FFL: 0 ;FLONUM WORDS LIST
DB$ FFD: SETZ ;DOUBLE-PRECISION FLONUMS
CX$ FFC: SETZ ;COMPLEX NUMBERS
DX$ FFZ: SETZ ;DOUBLE-PRECISION COMPLEX (DUPLEX)
BG$ FFB: 0 ;BIGNUM HEADERS
FFY: 0 ;SYMBOL (PNAME-TYPE ATOM) HEADERS
HN$ FFH: REPEAT HNKLOG+1, SETZ ;HUNKS
FFA: 0 ;SARS (ARRAY POINTERS)
NFF==:.-FFS ;NUMBER OF FF FROBS
FFY2: SY2ALC ;SYMBOL BLOCKS (EXPLICIT RETURN USED)
;;; SIGN BIT IN FF- MEANS EXEMPT FROM 40-WORD MINIMUM RECLAIMED.
.SEE GCSWH1
.SEE AGC1Q
.SEE GCE0C5
.SEE GCE0C9
.SEE HUNK
;;; PURE FREE STORAGE COUNTERS (NON-POSITIVE, RELATIVE TO EPFF- BELOW)
;;; MUST PRESERVE RELATIVE ORDERING THROUGH NPFFY2
NPFFS: 0 ;LIST
NPFFX: 0 ;FIXNUM
NPFFL: 0 ;FLONUM
DB$ NPFFD: 0 ;DOUBLE
CX$ NPFFC: 0 ;COMPLEX
DX$ NPFFZ: 0 ;DUPLEX
BG$ NPFFB: 0 ;BIGNUM
0 ;NO PURE SYMBOLS
HN$ NPFFH: REPEAT HNKLOG+1, 0 ;HUNKS
0 ;NO PURE SARS
NFFTBCK NPFFS
NPFFY2: 0 ;SYMBOL BLOCKS
;;; ADDRESS OF WORD ABOVE CURRENT PURE SEGMENT FOR EACH SPACE
;;; MUST PRESERVE RELATIVE ORDERING THROUGH EPFFY2
EPFFS: 0 ;LIST
EPFFX: 0 ;FIXNUM
EPFFL: 0 ;FLONUM
DB$ EPFFD: 0 ;DOUBLE
CX$ EPFFC: 0 ;COMPLEX
DX$ EPFFZ: 0 ;DUPLEX
BG$ EPFFB: 0 ;BIGNUM
0 ;NO PURE SYMBOLS
HN$ EPFFH: REPEAT HNKLOG+1, 0 ;HUNKS
0 ;NO PURE SARS
NFFTBCK EPFFS
EPFFY2: 0 ;SYMBOL BLOCKS
EFVCS: BVCSG+NVCSG*SEGSIZ ;END OF CURRENT VC REGION (EFVCS+NFVCS=LAST USED VC)
NFVCP: NXVCSG/SGS%PG ;NUMBER OF EXTRA VC PAGES
FFVC: BFVCS ;VALUE CELL FREELIST (EXPLICIT RETURN USED)
ETVCFLSP: 0 .SEE GCMARK ;EVER-TOOK-VALUE-CELL-FROM-LIST-SPACE-P
;;; GCMKL IS ARRANGED LIKE A PROPERTY LIST: THE "PROPERTY NAMES"
;;; ARE SARS, IN DECREASING ORDER OF POSITION IN ARRAY SPACE,
;;; AND THE "PROPERTY VALUES" ARE FIXNUMS DENOTING THE LENGTHS
;;; OF THE ARRAYS. USED BY GC, RETSP, GRELAR, *ARRAY, AND OTHERS
;;; TO KEEP TRACK OF ARRAYS. NOTE: THE INITIAL OBARRAY AND
;;; READTABLE ARE NOT IN GCMKL SINCE THEY ARE NOT IN BPS.
GCMKL: IGCMKL
;;; PROLIS IS AN ALIST USED TO PROTECT NON-ATOMIC READ-MACRO
;;; FUNCTIONS FROM BEING GC'ED. EACH ITEM ON THE
;;; ALIST IS OF THE FORM (FUN RDT . NUM) WHERE:
;;; FUN IS THE FUNCTION TO BE PROTECTED
;;; RDT IS THE SAR OF THE READTABLE CONCERNED
;;; NUM IS A LISP NUMBER (GUARANTEED NLISP INUM)
;;; <ASCII CHAR VALUE> FOR READ-MACRO FUNCTION
;;; PROLIS IS UPDATED BY SSGCPRO AND SSGCREL.
PROLIS: NIL
;;; VARIOUS RANDOM PARAMETERS FOR GARBAGE COLLECTOR.
;;; MUST PRESERVE RELATIVE ORDER WITHIN GROUPS.
;;; GCMIN PARAMETERS FOR EACH SPACE (FLONUM IFF LH NON-ZERO)
.SEE GCE0C0
MFFS: MINFFS ;LIST
MFFX: MINFFX ;FIXNUM
MFFL: MINFFL ;FLONUM
DB$ MFFD: MINFFD ;DOUBLE
CX$ MFFC: MINFFC ;COMPLEX
DX$ MFFZ: MINFFZ ;DUPLEX
BG$ MFFB: MINFFB ;BIGNUM
MFFY: MINFFY ;SYMBOL
HN$ MFFH: REPEAT HNKLOG+1, MINFFH ;HUNKS
MFFA: MINFFA ;SARS
NFFTBCK MFFS
;;; LENGTH OF FREELISTS <BEFORE,,AFTER>
.SEE GCP4B
NFFS: 0 ;LIST
NFFX: 0 ;FIXNUM
NFFL: 0 ;FLONUM
DB$ NFFD: 0 ;DOUBLE
CX$ NFFC: 0 ;COMPLEX
DX$ NFFZ: 0 ;DUPLEX
BG$ NFFB: 0 ;BIGNUM
NFFY: 0 ;SYMBOL
HN$ NFFH: REPEAT HNKLOG+1, 0 ;HUNKS
NFFA: 0 ;SARS
NFFTBCK NFFS
IFN USELESS*ITS,[
GCWHO: 0 ;VALUE OF (STATUS GCWHO)
;1.1 => DISPLAY MESSAGE DURING GC
;1.2 => CLOBBER .WHO2 WITH GC STATISTICS
GCWHO1: 0 ;SAVED VALUES OF WHO-LINE VARIABLES DURING GC
GCWHO2: 0
GCWHO3: 0
] ;IFN USELESS*ITS
GCACSAV: BLOCK NACS+1 ;MARKED ACS SAVED HERE
GCNASV: BLOCK 20-<NACS+1> ;UNMARKED ACS SAVED HERE
GCP=:GCACSAV+P
GCFLP=:GCACSAV+FLP
GCFXP=:GCACSAV+FXP ;TEST GCFXP FOR NON-ZERO TO DECIDE IF
GCSP=:GCACSAV+SP ; INSIDE GC (IMPLYING REAL PDL POINTERS ARE HERE)
PANICP: 0 ;-1 SAYS WE'RE CLOSE TO RUNNING OUT OF CELLS
GCMRKV: 0 ;NON-NIL MEANS MARK PHASE ONLY
GCTIM: 0 ;GC TIME
GCTM1: 0
GCUUSV: BLOCK LUUSV
IRMVF: 0 ;GCTWA REMOVAL OVERRIDE SWITCH
GCRMV: 0 ;WHETHER TO DO GCTWA REMOVAL
ARPGCT: 4 ;# OF PAGES TO GRAB FREELY FOR ARRAYS BEFORE GC
;;; PARAMETERS RELEVANT TO MEMORY ALLOCATION.
;;; MUST PRESERVE RELATIVE ORDERING OF MOST OF THIS STUFF.
;USED BY GC TO HOLD EXACT CALCULATED INTEGRAL GCMINS
ZFFS: 0 ;LIST
ZFFX: 0 ;FIXNUM
ZFFL: 0 ;FLONUM
DB$ ZFFD: 0 ;DOUBLE
CX$ ZFFC: 0 ;COMPLEX
DX$ ZFFZ: 0 ;DUPLEX
BG$ ZFFB: 0 ;BIGNUM
ZFFY: 0 ;SYMBOL
HN$ ZFFH: REPEAT HNKLOG+1, 0 ;HUNK
ZFFA: 0 ;SARS
NFFTBCK ZFFS
.SEE SSPCSIZE ;SIZE OF EACH SWEEPABLE SPACE. USED TO CALCULATE PERCENTAGE RECLAIMED.
SFSSIZ: NIFSSG*SEGSIZ ;LIST
SFXSIZ: NIFXSG*SEGSIZ ;FIXNUM
SFLSIZ: NIFLSG*SEGSIZ ;FLONUM
DB$ SDBSIZ: 0 ;DOUBLE
CX$ SCXSIZ: 0 ;COMPLEX
DX$ SDXSIZ: 0 ;DUPLEX
BG$ SBNSIZ: NBNSG*SEGSIZ ;BIGNUM
SSYSIZ: NSYMSG*SEGSIZ ;SYMBOL
HN$ SHNSIZ: REPEAT HNKLOG+1, 0 ;HUNKS
SSASIZ: NSARSG*SEGSIZ ;SARS
NFFTBCK SFSSIZ
;SIZES OF SPACES BEFORE START OF GC. COPIED FROM SFSSIZ ET AL. AT START OF GC.
OFSSIZ: 0 ;LIST
OFXSIZ: 0 ;FIXNUM
OFLSIZ: 0 ;FLONUM
DB$ ODBSIZ: 0 ;DOUBLE
CX$ OCXSIZ: 0 ;COMPLEX
DX$ ODXSIZ: 0 ;DUPLEX
BG$ OBNSIZ: 0 ;BIGNUM
OSYSIZ: 0 ;SYMBOL
HN$ OHNSIZ: REPEAT HNKLOG+1, 0 ;HUNKS
OSASIZ: 0 ;SARS
NFFTBCK OFSSIZ
;SIZE FOR EACH SPACE BELOW WHICH TO GRAB NEW SEGMENTS FASTLY
.SEE SGCSIZE ; (I.E. WITHOUT DOING A WHOLE GARBAGE COLLECTION FIRST)
GFSSIZ: MAXFFS ;LIST
GFXSIZ: MAXFFX ;FIXNUM
GFLSIZ: MAXFFL ;FLONUM
DB$ GDBSIZ: MAXFFD ;DOUBLE
CX$ GCXSIZ: MAXFFC ;COMPLEX
DX$ GDXSIZ: MAXFFZ ;DUPLEX
BG$ GBNSIZ: MAXFFB ;BIGNUM
GSYSIZ: MAXFFY ;SYMBOL
HN$ GHNSIZ: REPEAT HNKLOG+1, MAXFFH ;HUNKS
GSASIZ: MAXFFA ;SARS
NFFTBCK GFSSIZ
;;; ROOTS OF THE CHAINS LINKING LIKE PAGES IN THE GARBAGE COLLECTOR
;;; SEGMENT TABLE (GCST). FILLED IN AT INIT TIME.
FSSGLK: 0 ;LIST
FXSGLK: 0 ;FIXNUM
FLSGLK: 0 ;FLONUM
DB$ DBSGLK: 0 ;DOUBLE
CX$ CXSGLK: 0 ;COMPLEX
DX$ DXSGLK: 0 ;DUPLEX
BG$ BNSGLK: 0 ;BIGNUM
SYSGLK: 0 ;SYMBOL
HN$ HNSGLK: REPEAT HNKLOG+1, 0 ;HUNKS
SASGLK: 0 ;SARS
NFFTBCK FSSGLK
S2SGLK: 0 ;THIS MUST FOLLOW THOSE ABOVE! (SYMBOL BLOCKS)
BTSGLK: 0 ;LINKED LIST OF BIT BLOCKS
IMSGLK: 0 ;LINKED LIST OF UNALLOCATED IMPURE SEGMENTS (INIT SETS UP)
PRSGLK: 0 ;LINKED LIST OF UNALLOCATED PURE SEGMENTS
10$ SVPRLK: 0 ;SAVED PRSGLK WHEN HISEG GETS PURIFIED
PG$ LHSGLK: 0 ;LINKED LIST OF BLOCKS FOR LH HACK
BTBAOB:
PG$ -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,,BFBTBS←<5-SEGLOG>
PG% -<NBITSG*SEGSIZ/BTBSIZ>+NBITB,, .SEE IN10S5
MAINBITBLT: BFBTBS-1 ;END ADDRESS FOR BLT OF MAIN BIT BLOCK AREA
GC98: 0 ;RANDOM TEMP FOR GC
GC99: 0 ;RANDOMER TEMP FOR GC
.SEE SPURSIZE ;SIZE OF PURE FREE STORAGE AREAS - USED MAINLY BY STATUS,
.SEE LDXQQ2 ; BUT ALSO RANDOMLY USED BY DEC-10 FASLOAD INTO HISEG
PFSSIZ: NPFSSG*SEGSIZ ;LIST
PFXSIZ: NPFXSG*SEGSIZ ;FIXNUM
PFLSIZ: NPFLSG*SEGSIZ ;FLONUM
DB$ PDBSIZ: 0 ;AIN'T NO INITIAL PURE DOUBLES, SONNY!
CX$ PCXSIZ: 0 ;AIN'T NO INITIAL PURE COMPLICES, MAMA!
DX$ PDXSIZ: 0 ;AIN'T NO INITIAL PURE DUPLICES, DADDY!
BG$ PBNSIZ: 0 ;AIN'T NO INITIAL PURE BIGNUMS, BABY!
0 ;AIN'T NEVER NO PURE SYMBOLS!
HN$ PHNSIZ: REPEAT HNKLOG+1, 0 ;HUNKS (YOU GOTTA BE KIDDING!)
0 ;AIN'T NEVER NO PURE SARS NEITHER!
NFFTBCK PFSSIZ
PS2SIZ: NSY2SG*SEGSIZ ;SYMBOL BLOCKS
;;; ********** HAIRY PARAMETERS HACKED BY ALLOC **********
BPSH: ;BINARY PROG SPACE HIGH
PG% 0 ;FILLED IN BY ALLOC
PG$ <<ENDLISP+PAGSIZ-1>&PAGMSK>-1
BPSL: BBPSSG ;BINARY PROG SPACE LOW
IFN PAGING,[
HINXM: 0 ;ADDRESS OF LAST WORD OF NXM HOLE
] ;END OF IFN PAGING
IFE PAGING,[
HIXM: 0 ;ADDRESS OF LAST WORD OF LOW SEGMENT
MAXNXM: 0 ;HIGHEST USABLE WORD OF NXM ABOVE LOW SEGMENT
HBPORG: ENDHI ;FIRST AVAILABLE WORD OF HISEG FOR LOADING BINARY PROGRAMS
HBPEND: IF1,[0] IF2,[HILOC+<<ENDHI-HILOC-STDHI+PAGSIZ-1>&PAGMSK>-1]
] ;END OF IFE PAGING
;;; THESE TWO VALUES ARE USED FOR A QUICK-AND-DIRTY PDL NUMBER CHECK.
.SEE PDLNMK
.SEE SPECBIND ;AND OTHERS
NPDLL: 0 ;LOW END OF NUMBER PDL AREA
NPDLH: 0 ;HIGH END OF NUMBER PDL AREA
IFN PAGING,[
PDLFL1: 0 ;FOR FLUSHING PDL PAGES - SEE ERINIT
PDLFL2: 0 ;FOR UPDATING ST - SEE ERINIT
] ;END OF IFN PAGING
;;; THE NEXT FEW THINGS MUST BE IN THIS ORDER
.SEE SSGCMAX ;MAXIMUM SIZES FOR STORAGE SPACES
XFFS: 0 ;LIST
XFFX: 0 ;FIXNUM
XFFL: 0 ;FLONUM
DB$ XFFD: 0 ;DOUBLE
CX$ XFFC: 0 ;COMPLEX
DX$ XFFZ: 0 ;DUPLEX
BG$ XFFB: 0 ;BIGNUM
XFFY: 0 ;SYMBOL
HN$ XFFH: REPEAT HNKLOG+1, MAXFFH ;HUNKS
XFFA: 0 ;SARS
NFFTBCK XFFS
IFN PAGING,[
;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
XPDL: MAXPDL ;MASTER PDL POSITIONS TO GIVE
XFLP: MAXFLP ; PDL-LOSSAGE INTERRUPTS AT
XFXP: MAXFXP
XSPDL: MAXSPDL
;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
ZPDL: MAXPDL ;ACTUAL PDL POSITIONS FOR LOSING
ZFLP: MAXFLP ;INITIALIZED AT ERINIT FROM XPDL ET AL.
ZFXP: MAXFXP ; AND DIDDLED BY PDLOV AT OVERFLOW TIME
ZSPDL: MAXSPDL
] ;END OF IFN PAGING
;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
C2: -PAGSIZ+NACS+1+2,,PDLORG-1 ;STANDARD REG PDL PTR
FLC2: -PAGSIZ+2,,FLPORG-1 ;STANDARD FLO PDL PTR
FXC2: -PAGSIZ+2,,FXPORG-1 ;STANDARD FIX PDL PTR
SC2: -PAGSIZ+1+2,,SPDLORG ;STANDARD SPEC PDL PTR
;SC2 IS INITIALIZED TO ONE SLOT HIGHER THAN MIGHT BE EXPECTED
; IN ORDER TO ACCOMMODATE A ONE-SLOT OVERPOP IN SOME PLACES.
.SEE ERRPOP
ZSC2: SPDLORG ;SC2 WITH ZERO LEFT HALF
;;; THE NEXT FOUR THINGS MUST BE IN THIS ORDER
OC2: 0 ;ABS LIMITS FOR PDLS
OFLC2: 0
OFXC2: 0
OSC2: 0
SUBTTL RANDOM VARIABLES IN LOW CORE
;; Fast XCT'd cells for UUOLINK snapping
USRHNK: 0 ;Either 0 or CALL instruction: is this a special hunk?
SENDI: 0 ;Either 0 or CALL instruction: send msg to user's hunk
ICALLI: 0 ;Either 0 or CALL instruction: Apply user's hunk
;;; I GUESS THIS STUFF NEED NOT BE CONSIDERED SACRED
;;; SPACE FOR ALL CHANNELS AND INFERIORS AND USELESS INTS AND GC OVERFLOWS
MAYBE LINTAR==20+10*JOBQIO+5*USELESS+NFF
INTAR: 0 ;INDEX INTO INTERRUPT ARRAY (FIFO QUEUE)
BLOCK LINTAR ;ENTRIES OF FORM <INT #,,ARG FOR INT FN>
; RIGHT HALVES ARE PROTECTED BY GC
;;; ENOUGH FOR ALL CHANNELS AND INFERIORS AND USELESS INTS AND GC OVERFLOWS
MAYBE LUNREAR==20+10*JOBQIO+5*USELESS+NFF
UNRC.G: 0 ;-2/-3 FOR DELAYED ↑X/↑G INTERRUPT
IFN USELESS, UNRCLI: 0 ;ENTRY FOR DELAYED CLI INTERRUPT
IFN USELESS, UNRMAR: 0 ;ENTRY FOR DELAYED MAR INTERRUPT
UNRRUN: 0 ;ENTRY FOR DELAYED RUNTIME ALARMCLOCK
UNRTIM: 0 ;ENTRY FOR DELAYED REAL TIME ALARMCLOCK
UNREAR: 0 ;INDEX INTO "REAL TIME" INTERRUPT QUEUE
BLOCK LUNREAR ;ENTRIES OF FORM <ARG FOR INT FN,,INT #>
;ARGS IN UNREAR NEED NO GC PROTECTION
.SEE NOINTERRUPT
;;; INTERRUPT PDL
LIPSAV==:10 ;LENGTH OF CRUD PUSHED BY INTERRUPT
IPSWD1==:-7 ;WORD ONE (.PIRQC) INTERRUPTS TAKEN
IPSWD2==:-6 ;WORD TWO (.IFPIR) INTERRUPTS TAKEN
IPSDF1==:-5 ;SAVED .DF1
IPSDF2==:-4 ;SAVED .DF2
IPSPC==:-3 ;SAVED PC
IPSD==:-2 ;SAVED ACCUMULATOR D
IPSR==:-1 ;SAVED ACCUMULATOR R
IPSF==:0 ;SAVED ACCUMULATOR F
SA% MXIPDL==4 ;MAX SIMULTANEOUS INTERRUPTS
SA$ MXIPDL==10. ; (CALCULATED FROM THE DEFER WORDS
; IN THE INTERRUPT VECTOR):
; 1 MISCELLANEOUS
; 2 PDL OVERFLOW
; 1 MEMORY ERROR/ILLEGAL OP
LINTPDL==LIPSAV*MXIPDL+1 .SEE PDLOV
INTPDL: -LINTPDL,,INTPDL .SEE INTVEC
;EXTRA ROOM FOR ONE INTPDL OVERFLOW AND RESULTING EXTRA INTERRUPT
BLOCK LINTPDL+2*LIPSAV .SEE PDLOV
IT$ IOCINS: 0 ;USER IOC ERROR ADDRESS
IT$ .SEE IOCER8
IFN D10,[
IFN SAIL,[
;SAIL ONLY DEFINITIONS
ACBASE==:20 ;WHERE SAIL MONITOR SAVES USER ACS UPON INT
INTMAI==:004000,,000000 ;MAIL INTERRUPT
INTPAR==:000400,,000000 ;PARITY ERROR
INTCLK==:000200,,000000 ;CLOCK INTERRUPT
INTTTI==:000004,,000000 ;<ESCAPE>I INTERRUPT
INTPOV==:000000,,200000 ;PDL OV
INTILM==:000000,,020000 ;ILL MEMORY REF
INTNXM==:000000,,010000 ;NON EXISTANT MEMORY
] ;END IFN SAIL
REEINT: BLOCK 1
REENOP: BLOCK 1
APRSVT: BLOCK 1
REESVT: BLOCK 1
] ;END IFN D10
IFN D10+D20,[
INTALL: BLOCK 1
;FUDGE BIT DEFINITIONS FOR VARIOUS ITS PI BITS
;LEFT HALF BITS
SA$ %PIMAI==:4000,,
%PIPAR==:1000,,
%PIWRO==:200,,
;RH BITS
%PIMPV==:20000
%PIILO==:40
] ;END IFN D10+D20
;;; LH OF MUNGP => GC IS IN PROCESS OF USING MARK BITS
;;; IN SARS OR SYMBOLS
;;; RH OF MUNGP => ALIST IS IN PROCESS OF USING LH'S OF
;;; VALUE CELLS FOR SPECPDL HACKERY
;;; ERINIT CHECKS MUNGP AND ATTEMPTS TO RESTORE THINGS IF
;;; NECESSARY. THIS SHOULD HAPPEN ONLY IN THE CASE OF SOME
;;; GROSS BUG LIKE A MEMORY VIOLATION.
MUNGP: 0
;;; VARIABLES NEEDED FOR ERRPOP
ERRPAD: 0 ;SAVE RETURN ADDRESS
ERRPST: 0 ;SAVE T OVER UNWPRO
;;; TEMPORARIES FOR FASLOAD
BFTMPS::
SQ6BIT: 0 ;TEMPORARIES FOR SQUEEZE
SQSQOZ: 0
LDBYTS: 0 ;WORD OF RELOCATION BYTES
LDOFST: 0(TT) ;LOAD OFFSET (RELOCATION FACTOR = VALUE OF BPORG BEFORE LOAD)
LDAAOB: 0 ;AOBJN INDEX FOR ATOMTABLE ARRAY
LDTEMP: ;RANDOM TEMPORARY
LD6BIT: 0 ;PLACE TO ACCUMULATE SIXBIT WHILE CONVERTING FROM SQUOZE
; - FIRST 6 BITS OF NEXT WORD MUST BE ZERO
LDAPTR: 0(TT) ;WILL BE AN INDIRECT POINTER FOR ACCESSING THE ATOMTABLE
LDBPTR: 0(F) ;WILL BE AN INDIRECT POINTER FOR ACCESSING THE I/O BUFFER
LDF2DP: 0 ;.FNAM2-DIFFERENT-P
; (NON-ZERO --> FASLAP'S LDFNM2 DIFFERS FROM CURRENT FASLOAD'S)
LDASAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S ATOMTABLE ARRAY
LDBSAR: 0 ;ADDRESS OF SAR FOR FASLOAD'S I/O BUFFER ARRAY
IFE PAGING,[
LDXBLT: 0 ;BLT POINTER FOR ZAPPING CALLS FOR XCTS IN BPS
LDXSIZ: 0 ;0=XCT HACKERY NEVER DONE, -1=DONE AND PURIFIED,
; N>0=LENGTH (IN WORDS) OF AREA FOR XCTED CALLS
LDXSM1: 0 ;CONTAINS 1 LESS THAN LDXSIZ, AND RETAINS VALUE AFTER
; LDXSIZ BECOMES -1
LDXDIF: 0(D) .SEE LDPRC6
;RH WILL CONTAIN DIFFERENCE BETWEEN RH AND LH OF LDXBLT
] ;END IFE PAGING
LDHLOC: 0 ;HIGHEST LOC ASSEMBLED INTO + 1
LDEOFJ: 0 ;JUMP ADDRESS FOR END OF FASLOAD INPUT FILE
10$ LDEOFP: 0 ;USED FOR EOF HANDLING IN FASLOAD FOR D10
LFTMPS==:.-BFTMPS ;NUMBER OF FASLOAD TEMPORARIES
IFN PAGING,[
;MULTIPLE XCT SEGMENTS ASSEMBLY TIME PARAMETERS
;DESCRIPTION OF SEGMENT FORMAT:
;LDXPNT POINTS TO FIRST IMPURE SEGMENT IN THE CHAIN. THE RH OF LDXPSP
; WORD IN EACH SEGMENT IS THE POINTER TO THE PURIFIABLE SEGMENT ATTACHED
; TO THE IMPURE SEGMENT, AND THE LH OF LDXPSP IS THE POINTER TO THE NEXT
; SEGMENT OR 0 IF NO MORE SEGMENTS IN CHAIN. LDXLPC IS THE -COUNT OF THE
; NUMBER OF SLOTS FREE IN THE CURRENT SEGMENT. THE CURRENT SEGMENT IS THE
; ONE POINTED TO BY LDXLPL. IF LDXLPC IS >= 0, IT IS POSSIBLE THAT THE PURE
; SEGMENT ATTACHED TO C(LDXLPL) IS ACTUALLY PURE, AND THUS MAY NOT BE WRITTEN
; INTO. IF LDXPNT IS 0, THE DATABASE IS COMPLETELY INVALID.
; THE SEGMENT SIZE USED IS THE DEFAULT SEGMENT SIZE DEFINED BY SEGLOG AND
; SEGSIZ. IF LDXPFG IS -1, THEN A PURIFICATION HAS BEEN DONE. THIS FLAG IS
; USED SOLELY FOR (STATUS UUOLINKS). AN EMPTY SLOT IS ZERO IN BOTH THE PURE
; AND IMPURE SEGMENT. THE FIRST WORD THAT IS USED FOR DATA IN EACH SEGMENT
; IS LDXOFS. THIS IS COMPUTED SUCH THAT THE LAST WORD OF DATA IS ACTUALLY THE
; LAST WORD OF THE SEGMENT.
;HASHING VALUES
IFE SEGLOG-8.,[LDHSH1==:251.
LDHSH2==:241.]
IFE SEGLOG-9.,[LDHSH1==:509.
LDHSH2==:503.]
IFE SEGLOG-10.,[LDHSH1==:1019.
LDHSH2==:1021.]
LDX%FU==:90. ;WHAT PERCENTAGE FULL ANY PAGE IS ALLOWED TO GET
;THIS MUST BE LOCATION ZERO!
LDXPSP==:0 ;NEXT SEGMENT IN CHAIN,,PURE SEGMENT POINTER
LDXOFS==:SEGSIZ-LDHSH1-1 ;OFFSET OF FIRST WORD OF UUOLINKS
LDXPNT: 0 ;POINTER TO XCT PAGES
LDXLPC: 0 ;COUNT OF WORDS REMAINING ON LAST PAGE USED
LDXLPL: 0 ;STARTING LOCATION OF LAST PAGE USED
LDXHS1: 0 ;FIRST HASH VALUE
LDXHS2: 0 ;SECOND HASH VALUE
LDXPFG: 0 ;-1 WHEN PURIFIED
] ;END IFN PAGING
IT$ IUSN: 0 ;INITIAL USER SNAME - SET BY LISPGO
USN: BLOCK 2 ;USER SYSTEM NAME
EVPUNT: TRUTH ;DON'T EVAL FUNCTION ATOM
IFN D10,[
UWUSN: 0 ;UWRITE SNAME (I.E. PPN)
D10PTR: 0 ;AOBJN POINTER FOR DEC BUFFERS..
D10ARD: -200,,. ;I/O WORD FOR ARRAY DUMP AND FASL
0
D10NAM: 0 ;THIS WORD ;WILL BE ###LSP WHERE ###=JOB NR
D10REN: BLOCK 2 ;FILE NAME TO
] ;END OF IFN D10
IT% SYMLO: 0 ;LOW BOUNDARY FOR DDT'S SYMBOL TABLE
IFN SAIL,[
;DEFINE SOME EXTRA TTY RELATED BITS
%TXTOP==:4000 ;"TOP" KEY.
%TXSFL==:2000 ;"SHIFT-LOCK" KEY.
%TXSFT==:1000 ;"SHIFT" KEY.
%TXMTA==:400 ;"META" KEY.
%TXCTL==:200 ;"CONTROL" KEY.
%TXASC==:177 ;THE ASCII PART OF THE CHARACTER.
] ;END IFN SAIL
IT$ %TXSFL==:0 ;"SHIFT-LOCK" KEY DOESN'T EXIST ON ITS
RDOBJ8: RD8N ;OR RD8W FOR WHITE'S + HAC
ALGCF: 0 ;FLAG TO STOP THE GC WHILE IN ALLOC
AFILRD: -1 ;-1 => NO INIT FILE, >0 => CDR OF ALLOC COMMENT
GNUM: ASCII \G0000\ ;INITIAL GENSYM
;;; RANDOM STUFF FOR RANDOM NUMBER GENERATOR
;;; RNOWS, RBACK, AND RBLOCK MUST BE IN THAT ORDER.
IFN USELESS,[
MAYBE LRBLOCK==:71. ; 71 35
MAYBE ROFSET==:35. ;X +X +1 IS IRREDUCIBLE MOD 2 (ASK MACSYMA!)
] ;END OF IFN USELESS
IFE USELESS,[
MAYBE LRBLOCK==:7 ; 7 3
MAYBE ROFSET==:3 ;SO ALSO IS X +X +1 IRREDUCIBLE MOD 2
] ;END OF IFE USELESS
RNOWS: 0 .SEE INIRND ;INITIALIZED AT INIT TIME
RBACK: 0 .SEE SSRANDOM ;CAN BE RESTORED BY (SSTATUS RANDOM ...)
RBLOCK: BLOCK LRBLOCK .SEE RANDOM ;71. WORDS OF "RANDOM"NESS
RNTN2: .(T) ;CURRENT PNBUF WORD FOR COMPARE ON INTERN
;;; VARIABLES FOR ARRAY ALLOCATOR
BPPNR: 0 ;<SIZE OF ARRAY HEADER>,,-<SIZE OF ARRAY DATA>
GAMNT: 0 ;NUMBER OF WORDS REQUIRED, ON A CALL TO GETSP
GSBPN: 0 ;USED AS TEMPORARY BPEND WHILE BLT'ING DOWN ARRAYS
ADDSAR: 0 ;ADDRESS OF SPECIAL ARRAY CELL WHEN MAKIN ARRAY
TOTSPC: 0 ;<# OF ARRAY DIMS>,,<TOTAL SPACE NEEDED FOR ARRAY>
LLIP1: 0 ;<LARGEST LEGAL INDEX OF ARRAY>+1
INSP: 0 ;PSEUDO-PDL POINTER FOR ARRAY-ING
RTSP1: 0
RTSP3: 0
LOSEF: 77 ;LAP OBJECT STORAGE - EFFICIENCY FACTOR. FOR (STATUS LOSEF) = N,
;THERE WILL BE <1←N>-1 STORED HERE. SIZE OF GC PROTECTION ARRAY
OLDSXHASHP: TRUTH ;IF = (), THEN USE NEW STYLE SXHASH,
RWG: 0 ;IF = 0, THEN CREATE ERROR ON DIVIDE BY ZERO,
;OR FLOATING OVFLO ON CONVERSION OF BIGNUM
FLOV9A: 0 ;RANDOM TEMPS FOR FLOATING POINT
FLOV9B: 0 ; OVERFLOW INTERRUPT HANDLER
CPJSW: 0 ;IF NOT ZERO, THEN *RSET WAS ON, AND BAKTRACE WILL FIND MUCH
;INFORMATION FROM THE [FUN,,CPOPJ] TYPE STUFF ON THE PDL
PSYMF: 0 ;NON-ZERO DURING EXECUTION OF PSYM.
POFF: 0 ;VARIOUS ROUTINES INVOLVING $X'S FROM DDT DO JSR'S HERE
JRST PSYM1
PSMS: BLOCK 20 ;THIS SHOULD BE ENOUGH FOR LPSMTB
BLOCK 3
PSMTS: 0
PSMRS: 0
IT$ SQUOZE 0,. ;FOR A .BREAK 12,[4,,PS.S-1]
PS.S: 0 .SEE PSYM1
STQLUZ: 0 ;FOR SETQING NIL OR T - REMEMBER WHICH ONE OVER INTWAIT
NOPFLS: 0 ;NON-ZERO => PURIFY$G SHOULDN'T FLUSH PDLS
SAWSP: -1 ;SCREW-AROUND-WITH-SHARING-P: -1 SAYS WE MUS READ
; OUR CORE IMAGE IN FROM A "PURQIO" FILE
20$ PSYSP: -1 ;PURIFY-SYSTEM-PAGES -1 SAYS YES
ALVRNO: ASCIZ \0\ ;ASCII string with LISP version number -- set up
; at INITIALIZE time.
IFN ITS,[
PURDEV: 0 ;PDUMP FILE DEVICE NAME
PURFN1: 0 ;PDUMP FILE FN1
PURFN2: 0 ;PDUMP FILE FN2
PURSNM: 0 ;PDUMP FILE SNAME
SYSDEV: SIXBIT \SYS\
SYSFN1: SIXBIT \PURQIO\
SYSFN2: LVRNO
SYSSNM: SIXBIT \SYS\
] ;IFN ITS
SA$ FAKDDT: HALT ;FOR FAKING OUT THE WORLD
MAYBE LSJCLBUF==10 ;ENOUGH FOR 40. CHARS
SJCLBUF: 0 ;FIRST WORD HOLD NUMBER OF CHARS BUFFERED
BLOCK LSJCLBUF
0 ;INSURES THAT ILDBS WILL FINALLY SEE A ZERO
SUBTTL INITIAL READTABLE, OBARRAY (IN LOW CORE)
;;; INITIAL READ SYNTAX TABLE IN FORM OF AN ARRAY
-1,,0 ;IN NEWIO, WILL POINT TO MACRO CHAR LIST
RSXTB1: PUSH P,CFIX1
JSP TT,1DIMF
READTABLE
0
RCT: BLOCK LRCT-2 ;WHICH IS BLT'D IN FROM RCT0
TRUTH,,0 ;(STATUS TTYREAD),,(STATUS ABBREVIATE)
NIL,,TRUTH ;(STATUS TERPRI),,(STATUS ←)
;;; INITIAL OBLIST IN FORM OF ARRAY
-<OBTSIZ+1>/2,,IOBAR2
IOBAR1: JSP TT,1DIMS
OBARRAY
OBTSIZ+1+200
IOBAR2: BLOCK <OBTSIZ+1>/2
BLOCK 200/2 ;SINGLE CHAR OBJS TABLE (CREATED AS NEEDED)
SUBTTL PURTBL AND IPURIFIY
;;; PURE PAGE TABLE
;;; CONTAINS TWO BITS FOR EACH PAGE, 16 PAGES PER TABLE WORD
;;; MEANING OF BITS: 00=NXM 01=IMPURE
;;; 10=PURE 11=SPECIAL HACKERY NEEDED
IFN PAGING,[
PURTBL:
IF1,[
BLOCK NPAGS/20
IFN NPAGS&17, BLOCK 1
] ;END IF1
IF2,[
ZZW==. ;DARN WELL BETTER BE SAFE OVER THE FOLLOWING MESS!
.BYTE 2
ZZZ==0
$==3 ;FOR HAIRY PRINTOUT TO WORK
PRINTX \
INITIAL PURTBL MEMORY LAYOUT
[0=NXM, 1=IMPURE, 2=PURE, $=BPS/PDL/SCRATCH]
\
NLBTSG==0
NHBTSG==0
IFN LOBITSG, NLBTSG==NBITSG
.ELSE, NHBTSG==NBITSG
;;; IN THE IRP BELOW, COMMAS AND CR'S MARK GUARANTEED PAGE BOUNDARIES
IRP SPCS,,[ZER+LBT,ST,SYS,SAR+VC,XVC,IS2+SYM+XXA,XXZ,SY2+PFX+PFS+PFL+XXP
IFS+IFX+IFL+BN+XXB,HBT,BPS,NXM,FXP,XFXP,FLP,XFLP,P,XP
SP,XSP,SCR]BITS,,[1,1,2,1,0,1,0,2,1,1,$,0,$,0,$,0,$,0,$,0,$]
ZZX==0
IRPS SPC,,[SPCS]
ZZX==ZZX+N!SPC!SG
TERMIN
REPEAT ZZX/SGS%PG,[
BITS
ZZZ==ZZZ+1
IFE ZZZ&17,[
0
0
]
PRINTX \BITS\
IFE <ZZZ#10>&17, PRINTX \ \
IFE <ZZZ#20>&37, PRINTX \ \
IFE ZZZ&37,[
PRINTX \
\
]
] ;END OF REPEAT
TERMIN
.BYTE
IFN ZZZ-NPAGS,[
WARN \ZZZ,[=WRONG LENGTH FOR PURTBL (SHOULD BE ]\NPAGS,[)]
LOC ZZW
BLOCK NPAGS/20
IFN NPAGS&17, BLOCK 1
] ;END OF IFN ZZZ-NPAGS
PRINTX \
\
] ;END IF 2
] ;END OF IFN PAGING
.SEE PURIFY ;PURIFY ENTERS HERE
FPURF7: MOVSI F,2000 ;THIS BIT CONVERTS CALL TO CALLF, JCALL TO JCALLF
MOVEI T,VPURCL
PUSH P,T
FPURF1: HRRZ T,(T) ;CDR DOWN THE PURLIST
FPUR1Q: JUMPE T,POP1J
FPUR1A: HLRZ AR2A,(T)
PUSHJ P,LDSMSH ;TRY TO SMASH
JRST FPURF4 ;WIN
IORM F,(AR2A) ;LOSE - MAKE IT A CALLF/JCALLF
FPURF4: HRRZ T,@(P) ;WIN, SO CUT IT OUT OF PURCLOBRL
HRRZ T,(T)
HRRM T,@(P)
JRST FPUR1Q
IFN USELESS,[
IP0: ;PURIFY/DEPURIFY SOME PAGES
IFN D10, JRST (R) ;C HAS FLAG, NON-NULL MEANS PURIFY
IFN D20+ITS,[
LSH D,-PAGLOG ;CALLED BY JSP R,IP0
LSH TT,-PAGLOG ;USES B,C,T,TT,D,F
CAIGE TT,1
LERR [SIXBIT \1ST PAGE NOT PURE!\]
MOVEI B,(TT) ;FIGURE OUT PURTBL BYTE POINTER
IFN ITS,[
ROT B,-4
ADDI B,(B)
ROT B,-1
TLC B,770000
ADD B,[450200,,PURTBL]
SUBI D,-1(TT) ;CALCULATE NUMBER OF PAGES
IMULI TT,1001
TRO TT,400000 ;SET UP ARG FOR .CBLK20$ MOVSI 1,.FHSLF
SKIPN C
TLOA TT,400
SKIPA C,R70+2 ;IN PURTBL, 1=IMPURE, 2=PURE
MOVEI C,1
IP7:↓.CBLK TT, ;HACK PAGE
JSP F,IP1 ;IP1 HANDLES LOSSES
ADDI TT,1001
] ;END OF IFN ITS
IFN D20,[
ROT TT,-4
ADDA TT,(TT)
ROT TT,-1
TLC TT,770000
ADD TT,[450200,,PURTBL]
SUBI D,-1(B) ;CALCULATE NUMBER OF PAGES
HRRI 1,(TT)
HRLI 1,.FHSLF
MOVSI 2,(PA%RD+PA%EX)
SKIPN C
TLOA 3,(PA%CPY)
SKIPA F,R70+2
MOVEI F,1
IP7: SPACS
ADDI 1,1
ADDI 2,1
] ;END OF IFN D20
TLNN B,730000 ;FOR BIBOP, DEPOSIT BYTE IN PURTBL
TLZ B,770000
IT$ IDPB C,B
20$ IDPB F,TT
SOJN D,IP7
JRST (R)
IFN ITS,[
IP1: MOVE T,[4400,,<776000+<SFA*1000>>];ASSUME FAILURE WAS DUE TO SHARING
.CBLK T, ;USES ONLY T,TT
.LOSE 1000+%ENACR ;NO CORE AVAILABLE
LDB T,[111000,,TT]
LSH T,PAGLOG+22
HRRI T,<376+SFA>*PAGSIZ ;SO COPY PAGE INTO SOME FAKE PAGE
BLT T,<376+SFA>*PAGSIZ+1777 ;LIKE PAGE NUMBER 376
MOVE T,TT
ANDCMI T,377
IORI T,376+SFA
.CBLK T, ;MOVE PAGE MAP FOR 376 INTO LOSING PAGE POSITION
.LOSE
MOVEI T,376000+<SFA*1000>
.CBLK T, ;FLUSH ENTRY FOR PAGE 376
.LOSE
JRST (F)
] ;END OF IFN ITS
] ;END OF IFN ITS+D20
] ;END OF IFN USELESS
SUBTTL START-UP CODE, AFTER A FLUSHING SUSPEND
;NOTHING ON THIS PAGE IS FLUSHED WHEN/IF LISP'S PURE PAGES ARE CLEARED FROM
; CORE DURING A SUSPEND
IFN PAGING,[
NFLSS::
FLSTBL:
IF1, BLOCK <<777777←-SEGLOG>+1>/36.
IF2,[
.BYTE 1
IRP SPCS,,[ZER+LBT,ST,SYS,SAR+VC,XVC,IS2+SYM+XXA,XXZ,SY2+PFX+PFS+PFL+XXP
IFS+IFX+IFL+BN+XXB,HBT,BPS,NXM,FXP,XFXP,FLP,XFLP,P,XP
SP,XSP,SCR]BITS,,[1,1,2,1,0,1,0,2,1,1,$,0,$,0,$,0,$,0,$,0,$]
ZZX==0
IRPS SPC,,[SPCS]
ZZX==ZZX+N!SPC!SG
TERMIN
REPEAT ZZX/SGS%PG,[
IFE BITS-2, 1 ;GENERATE A FLUSH ENTRY IF PURE
.ELSE, 0 ; ELSE PAGE SHOULD NOT BE FLUSHED
]
TERMIN
.BYTE
BLOCK <<777777←-SEGLOG>+1>/36.-<.-FLSTBL>
] ;END OF IF2
] ;END OF IFN PAGING
IFN D20,[
ENTVEC: JRST LISPGO ;TOPS-20 ENTRY VECTOR
JRST CTRLG
0 ;TO BE FILLED IN WITH VERSION NUMBER IN
; BITS 4.6 - 3.7
] ;END OF IFN D20
IFN ITS\D20,[
FLSPA1: ASCIZ \:≠Job Suspended≠
\
FLSPA3: ASCIZ \:≠LISP pure pages flushed, and job Suspended≠
\
FLSDIE:
DEFINE FLDIMSG A
ASCIZ \:≠LOSE!! Cannot find file with pure pages for the LISP which this job was dumped from (version !A!).
\
TERMIN
FLDIMSG \LVRNON
SUSP4:
IFN ITS,[
.CALL PURCHK
.VALUE FLSDIE ; DIE, DIE, DIE IF NO SYSTEM PAGES
JUMPE TT,.-1
JRST SUSP3A
] ;END OF IFN ITS
IFN D20,[
MOVEI A,BSYSSG←-<SEGLOG+SGS%PG-1>
HRLI A,.FHSLF
RPACS
TLNE B,(PA%PEX)
JRST SUSP3A
HRROI 1,FLSDIE
PSOUT
JRST .-2
] ;END OF IFN D20
FLSSTARTUP:
JSP TT,SHARP1 ;BEFORE STARTING MUST HAVE A REAL CORE IMAGE
JRST SUSP4
SUSP3A: SETZM SAWSP ;WE HAVE ALREADY MAPPED OURSELVES IN
] ;END OF IFN ITS\D20
;;; HERE ON STARTUP AGAIN AFTER SUSPENSION
IFN SAIL*PAGING,[
JSP 10,E.START
] ;END OF IFN SAIL*PAGING
SUSP3:
20$ RESET ;RESET OURSELVES ON STARTUP
IFN SAIL*PAGING,[
SETZM VECALLEDP
] ;END OF IFN SAIL*PAGING
IFN D10\D20 JSP F,JCLSET ;GOBBLE DOWN ANY JCL
MOVE NIL,GCNASV+1 ;RESTORE IMPORTANT AC'S
MOVE T,[GCNASV+2,,FREEAC]
BLT T,17
SETZB A,B ;CLEAR OUT GARBAGE
SETZB C,AR1
SETZ AR2A,
SKIPN (FLP) ;RESTORE FXP UNLESS JCL WAS NIL
MOVE FXP,(FXP)
MOVNI T,1 ;AOBJN ON -1 LEAVES [1,,0] ON A KA10
AOBJN T,.+1 ; BUT [0] ON A KL OR KI
MOVEM T,KA10P
IFN ITS\D20,[
MOVE T,GCNASV
MOVEM T,LISPSW
JSP T,SHAREP ;RE-READ PURE PAGES IF EVERYTHING IS IN ORDER
] ;END OF IFN ITS\D20
IFN ITS,[
.SUSET [.ROPTION,,TT]
TLO TT,OPTINT+OPTOPC ;NEW-STYLE INTERRUPTS AND NO PC SCREWAGE
.SUSET [.SOPTION,,TT]
.SUSET [.SDF1,,R70]
.SUSET [.SDF2,,R70]
.SUSET [.SMASK,,IMASK]
.SUSET [.SMSK2,,IMASK2]
IFN USELESS,[
MOVE T,IMASK
TRNE T,%PIMAR
.SUSET [.SMARA,,SAVMAR]
] ;END OF IFN USELESS
] ;END OF IFN ITS
IFN D20,[
MOVEI T,CTRLG ;RESTORE "CONTINUE" ADDRESS
HRRM T,ENTVEC+1
JSP R,TNXSET ;MUST BE DONE BEFORE PION
] ;END OF IFN D20
IFN D10,[
MOVE T,GCNASV
HRRM T,.JBSA"
HLRM T,.JBREN
SA% JSP T,D10SET
] ;END OF IFN D10
PION
JSP T,PPNUSNSET
SETZM NOPFLS
HRRZS NOQUIT
PUSHJ P,OPNTTY ;*** TEMP CROCK?
JFCL
PUSHJ P,UDIRSET
POPI FLP,1 ;REMOVE NIL VALRET FLAG
POP FLP,A ;RESTORE RETURN VALUE
POPJ P,
NOSHARE==JRST (T) ;DEPOSIT INTO SHAREP TO INHIBIT SHAREING
SHAREP: SKIPN SAWSP
JRST (T)
SETZM SAWSP
IFN ITS,[
.CALL PURCHK
.VALUE
JUMPL TT,(T) ;NEGATIVE IF FIRST SYSTEM PAGE IS WRITEABLE
] ;END OF IFN ITS
JSP TT,SHARP1
JFCL ;IGNORE CASE OF LOST PURQIO FILE
JRST (T)
SHARP1:
IT% JRST (TT)
IT% WARN [HOW TO SHARE WITH "PURQIO" FILE?]
IFN ITS,[
.CALL SYSFIL ;GET SYSTEM FILE AND SHARES - SKIP IF WIN
JRST (TT)
.CALL SHRLOD ;LOAD ALL PURE PAGES FROM THE FILE
.LOSE 1400
.CLOSE TMPC,
JRST 1(TT)
SHRLOD: SETZ
SIXBIT \LOAD\
MOVEI %JSELF ;MYSELF
MOVEI TMPC ;CHANNEL ON WHICH PURQIO/PURBIB IS OPEN'ED
SETZI 0 ;LOAD ONLY PURE PAGES
] ;END OF IFN ITS
FLSLSP:
20$ JRST FLSNOT
IFN ITS,[
.CALL SYSFIL ;IN ORDER TO FLUSH PAGES, WE MUST BE CERTAIN
JRST FLSNOT ; THAT WE CAN GET OURSELVES BACK!
.CLOSE TMPC,
.CALL PURCHK ;ONLY FLUSH IF LISP IS PURE
.VALUE
JUMPLE TT,FLSNOT
SETOM SAWSP ;FLAG THAT WE MUST READ OURSELVES FROM THE FILE
MOVE T,[440100,,FLSTBL] ;POINTER INTO TABLE OF WHICH PAGES TO FLUSH
SETZI TT, ;KEEP PAGE NUMBER IN TT
FLSPA4: ILDB R,T ;GET INFO ON THIS PAGE
JUMPE R,FLSPA5 ;SKIP IF NOT FLUSHABLE
CAIE TT,NFLSS/PAGSIZ ;NEVER FLUSH THE PAGES WE ARE ON
CAIN TT,NFLSE/PAGSIZ
JRST FLSPA5
.CALL FLSPA6 ;ELSE FLUSH THE PAGE FROM OUR PAGE MAP
.LOSE 1400
FLSPA5: CAIGE TT,777777/PAGSIZ ;LOOP UNTIL HIGHEST PAGE NUMBER
AOJATT,FLSPA4
.SUSET FLSMCK ;MAKE SURE NO INTERRUPTS TRY TO HAPPEN
PUSHJ P,PDUMPL ;PURE DUMP LISP IF SO DESIRED
SKIPE (FLP) ;NIL JCL?
JRST SUSCON ;NOPE, RETURN T AND PROCEED
SKIPE TT,(FXP) ;CHECK IF VALRET STRING
JRST FLSVAL ;YES, MUST VALRET IT THEN
MOVE T,FXP
SUB T,FLSADJ
MOVEM T,(FXP)
.VALUE FLSPA3 ;PRINT SUSPENSION MESSAGE
JRST SUSCON ;CONTINUING AFTER A SUSPEND
FLSVAL: SKIPN VALFIX ;IS VALRET STRING REALLY A FIXNUM?
JRST FLSVA1 ;NO, USE FORMAL VALRET
HRRZ T,1(TT) ;PICKUP THE VALUE
.BREAK 16,(T) ;DO THE .BREAK
JRST SUSCON ;CONTINUE WHEN IT RETURNS, BUT RETURN T
FLSVA1: .VALUE 1(TT)
JRST SUSCON ;ON PROCEED, RETURN T
FLSADJ: 1,,1
FLSMSK: .SMASK,,.+1
0,,0
FLSPA6: SETZ
SIXBIT \CORBLK\
MOVEI 0 ;FLUSH THE PAGE
MOVEI %JSELF ;FROM OURSELVES
SETZ TT ;PAGE NUMBER IN TT
PURCHK: SETZ
SIXBIT \CORTYP\ ;GET TYPE FOR CORE BLOCK
1000,,BSYSSG/PAGSIZ ;THAT FIRST SYSTEM PAGE IS ON
402000,,TT ;>0 READ-ONLY, < 0 WRITABLE, = 0 NON-EXISTENT
SYSFIL: SETZ ;FOR OPENING UP FILE TO SHARE
SIXBIT \OPEN\
SYSCHN
SYSDEV
SYSFN1
SYSFN2
SETZ SYSSNM
SYSCHN: .UII,,TMPC
] ;END OF IFN ITS
;ROUTINE TO PDUMP A FILE WITH INDIRECT SYMBOL TABLE POINTER INCLUDED
IT% PDUMPL: POPJ P,
IFN ITS,[
PDUMPL: SKIPN PURDEV ;DID THE GUY WANT PURE DUMPING?
POPJ P, ;NOPE, RETURN RIGHT AWAY
.CALL PUROPN ;OPEN THE FILE FOR PDUMP'ING
.LOSE 1400 ;THE GUY LOST, OH WELL, WE ARE PROBABLY IN
; A SUSPEND ANYWAY
SETZ T, ;PDUMP REQUIRES AN INITALLY ZERO STATE WORD
.CALL PDUMP ;DO THE ACTUAL PDUMP
.LOSE 1400
.IOT TMPC,PURSTI ;OUTPUT START INSTRUCTION
.IOT TMPC,PURISP ;INDIRECT SYMBOL TABLE POINTER INDICATOR
MOVE TT,PURPTR ;POINTER TO FILENAMES
MOVE T,PURPTR ;START CHECKSUM
PURCKS: ROT T,1
ADD T,(TT) ;AND CHECKSUM FOR DDT
.IOT TMPC,(TT) ;ALSO OUTPUT THE WORD TO THE FILE
AOBJN TT,PURCKS
.IOT TMPC,T ;OUTPUT THE CHECKSUM
.IOT TMPC,PURSTI ;THEN AGAIN THE START ADR
.CALL PURRWO ;RENAME TO CORRECT FILENAME
.LOSE 1400
.CLOSE TMPC, ;FINISH UP WITH THE FILE
POPJ P,
PUROPN: SETZ
SIXBIT \OPEN\
PURCHN
PURDEV
PUROP1
PUROP2
SETZ PURSNM
PUROP1: SIXBIT \.LISP.\
PUROP2: SIXBIT \OUTPUT\
PURRWO: SETZ
SIXBIT \RENMWO\
MOVEI TMPC
PURFN1
SETZ PURFN2
PDUMP: SETZ
SIXBIT \PDUMP\
MOVEI %JSELF
MOVEI TMPC
SETZ T
PURCHN: .UIO,,TMPC
PURSTI: JRST LISPGO
PURISP: -4,,2
PURPTR: -4,,SYSDEV
] ;END OF IFN ITS
PG$ NFLSE:
SUBTTL KILHGH AND GETHGH
IFN SAIL,[
E.START:
SETOM E.PHANTOM
MOVEM 7,VEJOBNUM
MOVEM 0,E.FIL
MOVEM 1,E.EXT
MOVEM 3,E.PPN
MOVEM 6,E.DEV
MOVE A,VT.ITY
MOVEM A,VECALLEDP
JRST 1(10) ;RETURN + 1
E.PHANTOM: 0
E.FIL: SIXBIT \ EINIT\
E.EXT: SIXBIT \INI\
E.PPN: 0
E.DEV: SIXBIT \DSK\
] ;END OF IFN SAIL
IFN HISEGMENT,[
IFE SAIL,[
KILHG4: OUTSTR [ASCIZ \
;Not flushing high segment - can't find .SHR file
\]
KILHG2: MOVEI A,KILHG3 ;THIS SHOULD BE START ADR IF NOT KILLING HS
HRRM A,.JBSA
MOVE 0,SGANAM ;IMPORTANT INFO INTO ACS IN CASE OF CONTINUE
MOVE 11,SGADEV
MOVE 7,SGAPPN
EXIT 1, ;SUSPEND FOR A WHILE
KILHG3: MOVEM 0,SGANAM
MOVEM 11,SGADEV
MOVEM 7,SGAPPN
JRST RETHGH
] ;END IFE SAIL
KILHGH: MOVEI A,GETHGH ;KILL HIGH SEGMENT
HRRM A,.JBSA" ;SET START ADDRESS
IFE SAIL,[
SKIPN SUSFLS
JRST KILHG2
SKIPE SGANAM ;CAN'T FLUSH HIGH SEGMENT IF WE
SKIPN SGADEV ; DON'T KNOW WHEREFROM TO RETRIEVE IT
JRST KILHG4
MOVSI A,1
CORE A, ;FLUSH HIGH SEGMENT
JFCL
KILHG1:
] ;END OF IFE SAIL
IFN SAIL,[
SKIPE SUSFLS
SKIPN SGANAM
JRST KILHG1
MOVEI A,FAKDDT ;FOO, HOW MANY WAYS CAN SAIL LOSE?
SKIPN .JBDDT ; JOBDDT MUST BE NON-ZERO TO SAVE!
SETDDT A, ; OTHERWISE MAY FAIL TO SAVE ENTIRE LOSEG
SETZ A,
CORE2 A, ;FLUSH HIGH SEGMENT
HALT ;HOW CAN WE POSSIBLY LOSE? (HA HA)
JRST KILHG2
KILHG1: SKIPL .JBHRL
JRST KILHG2
MOVEI A,1
SETUWP A,
HALT
KILHG2:
] ;END OF IFN SAIL
EXIT 1, ;"CONTINUE" WILL FALL INTO GETHGH
IFN SAIL,[
JSP 10,E.START
] ;END OF IFN SAIL
GETHGH:
IFE SAIL,[
SETZM VECALLEDP
MOVEI A,A+1 ;SET UP TO GET HIGH SEG BACK
MOVE A+1,SGADEV
MOVE A+2,SGANAM
MOVE A+3,SGAEXT
MOVEI A+4,0
MOVE A+5,SGAPPN
SKIPE SGANAM
SKIPN SGADEV
JRST GETHG1
GETSEG A, ;GET HIGH SEGMENT
JRST GLSLUA
GETHG1:
] ;END OF IFE SAIL
IFN SAIL,[
JRST .+5 ;DAMN RPG STARTUP ON SAIL
RESET
CLRBFI
JRST .+2
RESET
SKIPE .JBHRL
JRST GETHG1
MOVE T,SGANAM
ATTSEG T,
SKIPA TT,SGADEV
JSP FREEAC,CHKHGH
MOVEI T,.IODMP ;ON FAILURE, LOCK THE SHR FILE, THEN TRY AGAIN,
SETZ D, ; AND ON FAILING MAKE THE HISEG OURSELVES
OPEN TMPC,T ;OPEN UP .SHR FILE DEVICE IN DUMP MODE
HALT ;SOME MORON GAVE LOSING SECOND ARG TO SUSPEND?
MOVE T,SGANAM
MOVE TT,SGAEXT
SETZ D,
GETSTS TMPC,R ;GET CHANNEL STATUS WORD
TRO R,1000 ;FAST READ-ALTER
SETSTS TMPC,(R) ;DO IT
MOVE R,SGAPPN
LOOKUP TMPC,T
JRST GLSLUA ;LOOK UP .SHR FILE
MOVS F,R
TRZ TT,-1 ;WE NOW OPEN IT FOR READ-ALTER MODE FOR
SETZ D, ; THE SOLE PURPOSE OF PREVENTING OTHER
MOVE R,SGAPPN ; JOBS FROM READING IT TOO, THEREBY
ENTER TMPC,T ; CAUSING WEIRD RACE CONDITIONS
JRST GLSLUA
MOVE T,SGANAM
ATTSEG T, ;SEE IF SOMEONE ELSE HAS SAME HISEG; THIS CAN
SKIPA T,F ; HAPPEN IF SOME OTHER JOB GETS THROUGH THIS
JSP FREEAC,CHKHGH ; CODE BETWEEN OUR FIRST ATTSEG AND THE ENTER
MOVNS T ;T GETS LENGTH OF .SHR FILE
ADD T,.JBREL
HRR R,.JBREL ;MUST GOBBLE SOME COPIES OF .JBREL
HRRZ TT,.JBREL ; BEFORE THE CORE UUO CHANGES IT
CORE T, ;EXTEND LOSEG BY THIS AMOUNT
JRST GLSLZ1
SETZ F,
IN TMPC,R ;READ IN HISEG
SKIPA T,SGANAM
JRST LDSCRU
TLO TT,HSGORG ;WRITE PROTECT HISEG
GETHG2: REMAP TT, ;LET'S SPLIT
JRST GLSLZ3
GETHG1:
MOVE T,SGANAM
SETNM2 T,
HALT
RELEASE TMPC, ;FLUSH TEMP CHANNEL *AFTER* CREATING THE HISEG
] ;END OF IFN SAIL
RETHGH: JRST . ;RETURN ADDR CLOBBERED IN HERE
GLSLUY: SIXBIT \CANNOT GET HIGH SEGMENT!\
GLSLUA: MOVEI C,GLSLUY
IFN SAIL,[
RELEASE TMPC,
TLZ TT,-1
CAIE TT,ERFBM% ;COLLISION DUE TO LOCKOUT?
JRST GLSLZ0 ;NO, GENUWINE LOSSAGE
PJOB TT, ;THIS IS ALL PRETTY RANDOM - WE'RE
IDIVI TT,7 ; TRYING JUST A LITTLE BIT TO SOLVE
SLEEP D, ; THE HAIRY RACE CONDITIONS (ALOHA!)
JRST GETHGH
CHKHGH: MOVE D,SGAPPN
CAME D,PSGPPN
JRST GLSLZ4
MOVE D,SGADEV
CAME D,PSGDEV
JRST GLSLZ4
MOVE D,SGAEXT
CAME D,PSGEXT
JRST GLSLZ4
MOVE D,SGANAM ;CHEAK HISEG VALIDATION WORDS
↓CAME D,PSGNAM
JRST GLSLZ4
JRST GETHG1
GLSLZ4: SETZ T, ;WRONG HISEG, SO ZERO IT OUT AND START AGAIN
CORE2 T,
JRST GLSLZ1
MOVE TT,SGADEV
MOVE T,F
JRST (FREEAC)
GLSLZ0:
] ;END OF IFN SAIL
HRLI C,440600 ;WILL READ A SIXBIT STRING
GLSLZA: ILDB T,C ;READ STRING AND TYPE IT
ADDI T," " ;CONVERT TO ASCII
OUTCHR T
CAIE T,"!" ;STOP AFTER EXCLAMATION-POINT
JRST GLSLZA
↓EXIT ;FOO
IFN SAIL,[
GLSLZ1: OUTSTR GLSLM1
EXIT
GLSLM1: ASCIZ \?CORE UUO LOST
\
GLSLZ2: OUTSTR GLSLM2
EXIT
GLSLM2: ASCIZ \?IN UUO LOST
\
GLSLZ3: OUTSTR GLSLM3
JRST GETHG2
GLSLM3: ASCIZ \?REMAP lost -- no job slots available, retrying
\
] ;END OF IFN SAIL
SGANAM:
SA% 0 ;THESE ARE THE SAVED NAMES FOR GETTING
SA$ SIXBIT \MACLSP\
SGADEV:
SA% 0 ; THE HIGH SEGMENT BACK AFTER SUSPENSION
SA$ SIXBIT \SYS\
SGAPPN: 0 .SEE SUSPEND
SGAEXT: SIXBIT \SHR\ ;SOME LOSER MIGHT WANT TO CHANGE THIS
;;; CODE FOR FASLOAD TO READ IN A NEW HIGH SEGMENT.
;;; THIS CODE MUST BE IN THE LOW SEGMENT!
;;; T HAS LENGTH OF THE .SHR FILE; LH(R) HAS NEGATIVE OF THIS.
LDRIHS:
IFE SAIL,[
MOVSI TT,1
CORE TT, ;FLUSH OLD HIGH SEGMENT
JRST LDSCRU
HRRZ TT,.JBREL ;CURRENT HIGHEST ADDRESS IN LOSEG
HRRZ D,.JBREL
HRR R,.JBREL
ADD TT,T
CORE TT, ;EXPAND LOSEG SO CAN HOLD COPY OF HISEG
JRST LDSCRU ; (REMEMBER, CAN'T DO I/O INTO HISEG!)
SETZ F,
IN TMPC,R ;READ IN .SHR FILE
CAIA
JRST LDSCRU
REMAP D, ;NOW MAKE A HISEG FROM THE READ-IN CODE
JRST LDSCRU
SETUWP F, ;TOPS-10 PROTECTS US FROM OURSELVES,
JRST LDSCRU ; SO WE MUST MAKE HISEG WRITABLE (F IS ZERO)
SETZM SGANAM ;WE NO LONGER KNOW THE HIGHSEG NAME!
;IF THIS IS NON-ZERO, HIGH-SEG GETS FLUSHED
; DURING (SUSPEND) AND ALL THE STUFF WE'VE
; DONE TO IT GOES BYEBYE! (ARG!)
POPJ P,
] ;END OF IFE SAIL
IFN SAIL,[
SETZ TT,
CORE2 TT, ;FLUSH OLD HIGH SEGMENT
JRST LDSCRU
LDRHS1: CORE2 T, ;MAKE A NEW (WRITABLE) HISEG THAT BIG
JRST LDSCRU
MOVE T,D10NAM ;USE D10NAM AS HISEG NAME TO MAKE HISEG UNIQUE
LSH T,-6 ;AS LONG AS WE'RE BEING RANDOM...
SETNM2 T, ;TRY TO SET NAME FOR HIGH SEGMENT
JFCL
HLRE T,R ;GET WORD COUNT SING EXTENDED
MOVMS T ;AND MUST GET A HI-SEG THAT BIG
HRRI R,HSGORG-1
SETZ F,
IN TMPC,R ;READ IN HISEG
POPJ P, ;RETURN TO CODE IN HISEG
] ;END OF IFN SAIL
LDSCRU: OUTSTR [ASCIZ \DEPURIFYING HISEG LOST - YOU ARE STRANDED!
\]
SA% EXIT
SA$ JRST LDRHS1
] ;END OF IFN HISEGMENT
SUBTTL LOBITSG TEST
CONSTANTS
;;; NO MORE CONSTANTS PERMITTED AFTER THIS IN THE LOSEG (WRITEABLE FIRST PAGE)
IF1,[
ZZ==.
LOBITSG==0 ;NON-ZERO ==> BITSGS ARE LOW
PAGEUP
TOP.PG==.
IFGE TOP.PG-ZZ-SEGSIZ,[ ;SEE IF THERE IS ANOTHER SEGMENT LEFT ON THIS PAGE
SEGUP ZZ
SPCTOP ZER,SYS,["ZERO" (LOW IMPURE)]
SPCBOT BIT
BTBLKS: BLOCK BTSGGS*SEGSIZ-1
SEGUP .
SPCTOP BIT,ST,[BIT BLOCK]
IFE TOP.PG-., LOBITSG==1
.ELSE,[
WARN [LOBITSG STUFF DIDN'T WORK]
EXPUNGE NZERSG NBITSG BBITSG
EXPUNGE BTBLKS
LOBITSG==0
] ;END OF .ELSE
] ;END OF IFGE TOP.PG-ZZ-SEGSIZ
] ;END OF IF1
IF2,[
IFN PAGING, PAGEUP
IFE PAGING, SEGUP .
] ;END OF IF2
IFE LOBITSG, SPCTOP ZER,SYS,["ZERO" (LOW IMPURE)]
PG% EXPUNGE BZERSG
EXPUNGE TOP.PG
SUBTTL SEGMENT TABLES
;;; FORMAT OF SEGMENT TABLE (<NSEGS> WORDS, ONE FOR EACH SEGMENT)
;;; 4.9 LS 1=LIST STRUCTURE, 0=ATOMIC
;;; 4.8 $FS FREE STORAGE (BIT 4.9 SHOULD BE ON ALSO)
;;; 4.7 FX FIXNUM STORAGE
;;; 4.6 FL FLONUM STORAGE
;;; 4.5 BN BIGNUM HEADER STORAGE
;;; 4.4 SY SYMBOL HEADER STORAGE
;;; 4.3 SA SAR STORAGE (BIT 3.8 SHOULD BE ON ALSO)
;;; 4.2 VC VALUE CELL STORAGE (BIT 4.9 SHOULD BE ON ALSO)
;;; 4.1 $PDLNM NUMBER PDL AREA
;;; (ONE OF THE NUMBER TYPE BITS SHOULD BE ON ALSO)
;;; 3.9 RESERVED - AVOID USING (FORMERLY $FLP)
;;; 3.8 $XM EXISTENT (RANDOM) AREA
;;; 3.7 $NXM NONEXISTENT (RANDOM) AREA
;;; 3.6 PUR PURE SPACE (ONE OF BITS 4.8-4.5 OR 3.8 SHOULD BE ON)
;;; 3.5 HNK HUNK OF ONE KIND OR ANOTHER (BIT 4.9 ON ALSO)
;;; 3.4 DB DOUBLE-PRECISION FLONUMS ;THESE ARE
;;; 3.3 CX COMPLEX NUMBERS ; NOT YET
;;; 3.2 DX DOUBLE-PRECISION COMPLEX NUMBERS ; IMPLEMENTED
;;; 3.1 UNUSED
;;; 2.9-1.1 ADDRESS OF A DATA TYPE, ATOM:
;;; QLIST, QFIXNUM, QFLONUM, QBIGNUM,
;;; QSYMBOL, QRANDOM, QARRAY, QHUNK<N>
;;; NOTE THAT THESE ATOMS OCCUPY CONSECUTIVE MEMORY
;;; LOCATIONS AND THUS NUMERICALLY ENCODE THE PAGE TYPE.
;;; THIS COMMENT SHOULD BE KEPT CONSISTENT WITH THE DEFINITIONS (IN THE
;;; DEFNS FILE) FOR THE ABOVE SYMBOLS, AND WITH LOCATION PSYMTT.
.SEE LS
.SEE PSYMTT
SPCBOT ST
ST: ;SEGMENT TABLE
IFE PAGING, BLOCK NSEGS ;FOR PAGING SYSTEM, CODE IN INIT SETS UP
; THESE TABLES AT RUN TIME.
IFN PAGING,[
IF1, BLOCK NSEGS
IF2,[
STDISP: EXPUNGE STDISP ;FOR .SEE
$ST ZER,$XM ;"ZERO" (LOW IMPURE) SEGMENTS
IFN LOBITSG, $ST BIT,$XM ;BIT BLOCKS
$ST ST,$XM ;SEGMENT TABLES
$ST SYS,$XM+PUR ;SYSTEM CODE
$ST SAR,SA ;SARS (ARRAY POINTERS)
$ST VC,LS+VC ;VALUE CELLS
$ST XVC,$NXM ;RESERVED FOR EXTRA VALUE CELLS
$ST IS2,$XM ;IMPURE SYMBOL BLOCKS
$ST SYM,SY ;SYMBOL HEADERS
$ST XXA,$XM ;SLACK SEGMENTS (IMPURE!)
$ST XXZ,$NXM ;SLACK SEGMENTS (INITIALLY NXM)
$ST SY2,$XM+PUR ;PURE SYMBOL BLOCKS
$ST PFX,FX+PUR ;PURE FIXNUMS
$ST PFS,LS+$FS+PUR ;PURE FREE STORAGE (LIST)
$ST PFL,FL+PUR ;PURE FLONUMS
$ST XXP,$XM+PUR ;SLACK PURE SEGMENT (FOOEY!)
$ST IFS,LS+$FS ;IMPURE FREE STORAGE (LIST)
$ST IFX,FX ;IMPURE FIXNUMS
$ST IFL,FL ;IMPURE FLONUMS
IFN BIGNUM, $ST BN,BN ;BIGNUMS
$ST XXB,$XM ;SLACK SEGMENTS (IMPURE!)
IFE LOBITSG, $ST BIT,$XM ;BIT BLOCKS
$ST BPS,$XM ;BINARY PROGRAM SPACE
$ST NXM,$NXM ;(INITIALLY) NON-EXISTENT MEMORY
$ST FXP,FX+$PDLNM ;FIXNUM PDL
$ST XFXP,$NXM ;FOR FXP EXPANSION
$ST FLP,FL+$PDLNM ;FLONUM PDL
$ST XFLP,$NXM ;FOR FLP EXPANSION
$ST P,$XM ;REGULAR PDL
$ST XP,$NXM ;FOR P EXPANSION
$ST SP,$XM ;SPECIAL PDL
$ST XSP,$NXM ;FOR SP EXPANSION
$ST SCR,$NXM ;SCRATCH SEGMENTS
.HKILL ST.ZER
IFN ST+NSEGS-., WARN \.-ST,[=WRONG SEGMENT TABLE LENGTH (SHOULD BE ]\NSEGS,[)]
] ;END IF2
] ;END IFN PAGING
;;; THE FORMAT OF THE GARBAGE COLLECTOR SEGMENT TABLE IS RATHER HAIRY, SINCE
;;; THE SIZES AND POSITIONS OF ALL FIELDS IN EACH WORD ARE DEPENDENT ON THE
;;; SEGMENT SIZE. THE LOW ORDER <22-<SEGLOG-5>> BITS OF EACH ENTRY CONTAIN
;;; THE HIGH BITS OF THE ADDRESS OF THE BLOCK OF BITS TO BE USED IN MARKING
;;; THAT SEGMENT. (NOTE THAT THE OMITTED LOW-ORDER BITS OF THIS ADDRESS ARE
;;; ZERO ANYWAY.) THESE ADR BITS ARE IN THIS STRANGE RIGHT-ADJUSTED POSITION
;;; FOR THE CONVENIENCE OF THE GCMARK ROUTINE (Q.V.). NOT ALL SEGMENTS HAVE
;;; BIT BLOCKS; THOSE WHICH DO NOT HAVE A BIT BLOCK HAVE ZERO IN THIS FIELD.
;;; TO THE LEFT OF THIS BIT BLOCK ADDRESS FIELD IS A FIELD OF <22-SEGLOG> BITS;
;;; THIS CONTAINS THE NUMBER OF THE NEXT SEGMENT IN THE TABLE OF THE SAME TYPE.
;;; (NOT ALL SEGMENTS ARE LINKED IN THIS WAY; THOSE SEGMENTS WHICH ARE NOT
;;; LINKED TO ANOTHER ONE HAVE THIS FIELD ZERO.) THE HIGH-ORDER BIT (BIT 4.9)
;;; IS ONE IFF GCMARK SHOULD MARK (PERHAPS NOT WITH A BIT BLOCK) THE CONTENTS
;;; OF THE SEGMENT. THE BIT 22 BIT POSITIONS TO THE LEFT OF THE HIGH-ORDER
;;; BIT OF THE BIT BLOCK ADDRESS FIELD IS ONE IFF GCMARK SHOULD MARK FROM THE
;;; CDR OF AN OBJECT IN THE SEGMENT; THIS BIT IS MEANINGFUL ONLY IF BIT 4.9
;;; IS ONE. THE BIT TO THE RIGHT OF THE CDR BIT IS ONE IFF GCMARK SHOULD ALSO
;;; MARK FROM THE CAR OF AN OBJECT IN THE SEGMENT; THIS BIT IS MEANINGFUL ONLY
;;; IF THE CDR BIT IS ONE. THESE THREE BITS MUST BE IN THESE EXACT POSITIONS,
;;; AGAIN FOR THE CONVENIENCE OF GCMARK (Q.V.). THE OTHER BITS IN EACH WORD
;;; ARE ARRANGED AS TO USE UP FREE BITS FROM THE LEFT END OF THE WORD, PACKED
;;; IN AROUND THE THREE BITS ALREADY DESCRIBED. THESE BITS INDICATE WHETHER
;;; OR NOT THE SEGMENT CONTAINS VALUE CELLS, SYMBOLS, OR SARS.
GCBMRK==400000 ;THESE ARE ALL LEFT HALF FLAGS
GCBCDR==1←<22-<SEGLOG-5>-1>
GCBCAR==GCBCDR←-1
GCB==1,,525252 ;FOR BIT TYPEOUT MODE
ZZZ==400000
GCBFOO==0
IRPS NAM,X,[VC+SYM+SAR+HNK ]
ZZZ==ZZZ←-1
IFN ZZZ&GCBCDR, ZZZ==ZZZ←-2
GCB!NAM==ZZZ
IFSE X,+, GCBFOO==GCBFOO\ZZZ
TERMIN
IFG GCBHNK-GCBCAR, WARN [GCMARK WILL LOSE ON HUNKS]
GCST: ;GC SEGMENT TABLE
IFE PAGING, BLOCK NSEGS ;FOR PAGING SYSTEM,
; THE GCST TABLE IS SET UP AT RUN TIME BY INIT.
IFN PAGING,[
IF1, BLOCK NSEGS
IF2,[
BTB.==BTBLKS ;LOCATION COUNTER FOR ASSIGNING BIT BLOCKS
$GCST ZER,,,0
IFN LOBITSG, $GCST BIT,,,0
$GCST ST,,,0
$GCST SYS,,,0
$GCST SAR,L,,GCBMRK+GCBSAR
$GCST VC,,,GCBMRK+GCBVC
$GCST XVC,,,0
$GCST IS2,L,,0
$GCST SYM,L,,GCBMRK+GCBSYM
$GCST XXA,L,,0
$GCST XXZ,,,0
$GCST SY2,,,0
$GCST PFX,,,0
$GCST PFS,,,0
$GCST PFL,,,0
$GCST XXP,,,0
$GCST IFS,L,B,GCBMRK+GCBCDR+GCBCAR
$GCST IFX,L,B,GCBMRK
$GCST IFL,L,B,GCBMRK
IFN BIGNUM, $GCST BN,L,B,GCBMRK+GCBCDR
LXXBSG==LXXASG
$GCST1 NXXBSG,XXB,L,,0
IFE LOBITSG, $GCST BIT,,,0
$GCST BPS,,,0
$GCST NXM,,,0
$GCST FXP,,,0
$GCST XFXP,,,0
$GCST FLP,,,0
$GCST XFLP,,,0
$GCST P,,,0
$GCST XP,,,0
$GCST SP,,,0
$GCST XSP,,,0
$GCST SCR,,,0
↓.HKILL GS.ZER
IFN GCST+NSEGS-., WARN \.-GCST,[=WRONG GC SEGMENT TABLE LENGTH (SHOULD BE ]\NSEGS,[)]
] ;END IF2
] ;END OF IFN PAGING
PAGEUP
SPCTOP ST,,[SEGMENT TABLE]
IFN PAGING, SPCBOT SYS
10$ $HISEG
10$ HILOC==. ;ORIGIN OF HIGH SEGMENT
SA$ PSGNAM: 0 ;THESE DOCATIONS FOR SAIL HISEG VALIDATION
SA$ PSGDEV: 0
SA$ PSGEXT: 0
SA$ PSGPPN: 0
SUBTTL BEGINNING OF PUBE LISP SYSTEI CODE
PGBOT ERR
;;; THESE CONSTANTS ARE BUILT INTO THE COIPILER.
;;; THEY MUST BE DEFINED HERE FOR THE BENEFIT OF THE PUSHN MACRO.
.SEE PUSHN
NNPUSH==:20 .SEE NPUSH
N0PUSH==:10 .SEE 0PUSH
N0.0PUSH==:10 .SEE 0. PUSH
BPURPG==:. ;BEGINNING OF PURE PAGES FOR INSERT FILE PAGE AND PURIFY
$$$NIL: 777300,,VNIL ;SYMBOL BLOCK FOR NIL
0,,$$NIL ;ALWAYS KEEP ON FIRST PURE SYSTEM PAGE
$INSRT ERROR ;ERROR MSGS AND HANDLERS
;;; ERROR FILE HAS DEFINITION FOR BEGFUN
PGTOP ERR,[ERROR HANDLERS AND MESSAGES]
PGBOT TOP
;;; LISPGO HAS BEEN MOVED SO IT WILL STAY IN CORE WHEN PURE PAGES ARE FLUSHED
;;; AT SUSPEND TIME AS CONTROLLED BY THE SUSFLS FLAG.
SUBTTL BASIC TOP LEVEL LOOP
;;; (DEFUN STANDARD-TOP-LEVEL ()
;;; (PROG (↑Q ↑W ↑R EVALHOOK BASE IBASE ...)
;;; ERROR ;ERRORS, UNCAUGHT THROWS, ETC. COME HERE
;;; ↑G ;↑G QUITS COME HERE
;;; (RESET-BOUND-VARIABLES-AND-RESTORE-PDLS)
;;; (SETQ ↑Q NIL)
;;; (SETQ ↑W NIL)
;;; (SETQ EVALHOOK NIL)
;;; (NOINTERRUPT NIL)
;;; (DO-DELAYED-TTY-AND-ALARMCLOCK-INTERRUPTS)
;;; ;RECALL THAT ERRORS DO (SETQ // ERRLIST)
;;; (MAPC (FUNCTION EVAL) //)
;;; (OR (TOP-LEVEL-LINMODE) (TERPRI))
;;; (DO ((PRT '* *))
;;; (NIL) ;DO FOREVER (UNTIL ERROR OR ↑G QUIT)
;;; (SETQ * (COND ((STATUS TOPLEVEL)
;;; (EVAL (STATUS TOPLEVEL)))
;;; ((PROG ()
;;; (READ-EVAL-*-PRINT PRT) ;print
;;; (READ-EVAL-PRINT-*) ;terpri
;;; A (SETQ TEM (*-READ-EVAL-PRINT)) ;read
;;; (AND (EQ TEM <INTERNAL-EOF-MARKER>)
;;; (PROG2 (TERPRI) (GO A)))
;;; (RETURN (READ-*-EVAL-PRINT TEM)))))) ;eval
;;; )))
LSPRET: PUSHJ FXP,ERRPOP
MOVE P,C2 ;RETURN TO TOP LEVEL BY ERR, THROW, AND ERRORS
LSPRT1: JSP T,TLVRSS ;RETURN TO TOP BY ↑G
JSP A,ERILIT
SETZ A, ;NEED A NIL IN A FOR CHEAKU
PUSHJ P,CHECKU ;CHECC FOR DELAYED "REAL TIME" INTS
MOVEI A,QOEVAL
SKIPE B,VIQUOTIENT ;SHADES OF ERRLIST!!!
CALLF 2,QMAPC
HACENT: PUSH P,FLP .SEE PDLCHK
PUSH P,FXP
PUSH P,SP
α PUSH P,LISP1 ;ENTRY FROM LIHAC
HRRZ F,VINFILE ;ONLY PRINT FIRST ASTERISK IF NO ANIT FILE
AOSN TOPAST ;IS THIS THE FIRST TIME?
CAIE F,INIIFA
SKIPA ;NOT (INIT-FILE AND FIRST-TIME)
JRST LISP2B
PUSH P,[Q.]
JSP F,LINMDP
PUSHJ P,ITERPRI
JRST LISP2 ;KLUDGE SO AS NOT TO MUNC *
LISP1: PUSH P,LISP1↓ ;******* BASIC TOP LEVEL LOOP *******
HRRZM A,V. ;THE SYMBOL * GETS AS ITS VALUE THE
PUSH P,A
LISP2~ JSP T,TLVRSS ; RESULT OF THE LAST TOP-LEVEL EVAL
POP P,B
↓SKIPN A,TLF
JRST LISP2A
HRRZ TT,-3(P)
↓HRRZ D,-2(P)
HRRZ R -1(P)
PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
JRST EVAL
LISP2A: MOVEI A,(B)
PUSHJ P,TLPRINT ;PRINT THE LAST OUTPUT FORM
HRRZ TT,-3(P)
HRRZ D,-2(P)
HRRZ R,-1(P)
PUSHJ P,PDLCHK ;CHECK PDL LEVELS FOR ERRORS
PUSHJ P,TLTERPRI ;OUTPUT A TERPRI
LISP2B: PUSHJ P,TLREAD ;READ AN INPUT FORM
JRST TLEVAL ;EVALUATE IT, RETURNING TO LISP1 IF NO EOF
SETZ AR1,
PUSHJ P,TERP1
JRST LISP2B ; LOOP BACK AFTER EOF-PROCESSED EXIT
;;; (DEFUN STANDARD-IFILE ()
;;; (COND ((OR (NULL ↑Q) (EQ INFILE 'T)) TYI)
;;; ('T INFILE)))
STDIFL: HRRZ A,VINFILE
SKIPE TAPRED
CAIN A,TRUTH
HRRZ A,V%TYI
POPJ P,
;;; (DEFUN READ-EVAL-PRINT-* () ;TOP-LEVEL-TERPRI
;;; (AND READ-EVAL-PRINT-*
;;; (FUNCALL READ-EVAL-PRINT-*))
;;; ((LAMBDA (IFILE)
;;; (AND (TTYP IFILE)
;;; (TOP-LEVEL-TERPRI-X (STATUS LINMODE IFILE)
;;; (STATUS TTYCONS IFILE))))
;;; (STANDARD-IFILE)))
;;;
;;; (DEFUN TOP-LEVEL-TERPRI-X (LM OFILE)
;;; (AND OFILE
;;; (COND ((EQ OFILE TYO)
;;; (TERPRI (CONS T (AND ↑R OUTFILES))))
;;; (T (OR LM ↑W (TERPRI OFILE))))))
TLTERPRI:
SKIPE B,VTLTERPRI ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 0,(B)
PUSHJ P,STDIFL ;GET STANDARD INPUT FILE
MOVE C,A
JSP F,STBIDP ;IF INPUT FILE IS BI-DIRECTIONAL
POPJ P, ; THEN WE WANT TO TERPRI IT
MOVEI TT,F.MODE ;HAS LEFT INPUT'S TTYCONS IN C
MOVE F,@TTSAR(A)
;TOP-LEVEL-TERPRI-X; TTYCONS IN C, F.MODE IN F,
TLTERX: CAME C,V%TYO
JRST TLTER1
SKIPE AR1,TAPWRT ;IF SAME AS TYO, TERPRI TO
HRRZ AR1,VOUTFILES ; STANDARD OUTPUT FILES
JRST TERP1
TLTER1: TLNN F,FBT.LN ;IF INPUT FILE NOT IN LINMODE,
SKIPE TTYOFF ; AND ↑W IS NOT SET,
POPJ P, ; TERPRI TO JUST THE TTYCONS FILE
TLO AR1,-1
JRST TERP1
;;; (DEFUN *-READ-EVAL-PRINT () ;TOP-LEVEL-READ
;;; (AND *-READ-EVAL-PRINT
;;; (FUNCALL *-READ-EVAL-PRINT))
;;; (DO ((EOF (LIST 'TLRED1)) (IFILE) (FORM))
;;; (NIL) ;DO UNTIL RETURN
;;; (SETQ IFILE (STANDARD-IFILE IFILE))
;;; (SETQ FORM (COND (READ (FUNCALL READ EOF))
;;; ('T (READ EOF))))
;;; (COND ((NOT (EQ FORM EOF))
;;; (AND (NULL READ)
;;; (ATOM FORM)
;;; (IS-A-SPACE (TYIPEEK))
;;; (TYI))
;;; (RETURN FORM)))
;;; (COND ((TTYP IFILE)
;;; (TOP-LEVEL-TERPRI-X () (STATUS TTYCONS IFILE)))
;;; ('T (RETURN <INTERNAL-EOF-MARKER>)))))
$TLREAD: PUSHJ P,TLREAD
POPJ P,
SETZ AR1,
PUSHJ P,TERP1
JRST $TLREAD
TLREAD: SKIPE B,V$TLREAD ;CHECK FOR USER'S INTERCEPT FUNCTION,
CALLF 0,(B) ; AND RUN IT.
PUSHJ P,STDIFL ;GET STANDARD INPUT FILE AS OF
PUSH P,A ; *BEFORE* THE READ, AND SAVE IT
PUSHJ P,[PUSH P,(P) ;ARGUMENT FOR RANDOM EOF VALUE
MOVNI T,1 ;READ THE FORM (POSSIBLY USING USER'S READ)
SKIPE VOREAD ; AND POSSIBLY POPPING INSTACK INTO INFILE
JCALLF 16,@VOREAD
JRST OREAD]
TLRED1: POP P,C
CAIE A,TLRED1
JRST TLREDF
JSP F,STBIDP ;GET BI-DIRECTIONAL ASSOCIATE, IF IT EXISTS,
JRST POPJ1 ; OF STREAM IN B INTO AR1
SETZ F, ;EOF ON TTY MEANS OVER-RUBOUT, SO
PUSHJ P,TLTERX ; TERPRI ON ASSOCIATED OUTPUT TTY
JRST TLREAD ; AND TRY AGAIN
TLREDF: SKOTT A,LS ;SPCFLS - FLUSH A <SPACE> TERMINATING AN ATOM
SKIPE VOREAD
POPJ P, ;NORMAL EXIT - NO EOF, NO SKIP
PUSH P,A
MOVEI T,0 ;PEEL OFF A SPACE, IF THAT
PUSHJ P,TYIPEEK+1 ;WAS WHAT TERMINATED THE ATOM
MOVE T,VREADTABLE
MOVE TT,@TTSAR(T)
MOVEI T,0
TLNE TT,100000 ;WORTHLESS CHAR, OR SPACE ETC.
PUSHJ P,%TYI
JRST POPAJ
;;; (DEFUN READ-*-EVAL-PRINT (FORM) ;TOP-LEVEL-EVAL
;;; (AND READ-*-EVAL-PRINT
;;; (FUNCALL READ-*-EVAL-PRINT FORM))
;;; (SETQ - FORM)
;;; ((LAMBDA (+)
;;; (PROG2 NIL
;;; (EVAL +)
;;; (AND (OR (CAR NIL) (CDR NIL))
;;; (ERROR '|NIL CLOBBERED|
;;; (PROG2 NIL
;;; (CONS (CAR NIL) (CDR NIL))
;;; (RPLACA NIL NIL)
;;; (RPLACD NIL NIL))
;;; 'FAIL-ACT))))
;;; (PROG2 NIL + (SETQ + (COND ((EQ - '+) +) ('T -))))))
TLEVAL: SKIPE B,VTLEVAL ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 1,(B)
MOVEM A,VIDIFFERENCE ;THE SYMBOL - GETS THE TYPED-IN
CAIN A,QIPLUS
SKIPA B,VIPLUS
MOVEI B,(A) ; EXPRESSION AS ITS VALUE AND KEEPS IT
EXCH B,VIPLUS ;THE SYMBOL + GETS THE THE TYPED-IN
JSP T,SPECBIND ; EXPRESSION AS ITS VALUE, BUT NOT
0 B,VIPLUS ; UNTIL AFTER IT HAS BEEN EVALUATED.
CEVAL: PUSHJ P,EVAL ;SPECBINDING IT ENSURES THAT IT WILL
JUMPE UNBIND ; GET THIS VALUE IN SPITE OF ERRORS.
PUSH P,CUNBIND
NILBAD: PUSH P,A ;FOO! WELL, ERROR HANDLING SAVES
PUSH P,CPOPAJ ;ALL ACS IN CASE YOU WANT TO CONTINUE
MOVS A,NIL
CSETZ: SETZ NIL, ;NIL=0! CAN USE THIS AS A CONSTANT WORD
PUSHJ P,ACONS
%FAC [SIXBIT \NIL CLOBBERED!\]
;;; PUSHJ HERE WITH PROPER VALUES FOR THE RIGHT HALVES
;;; OF <FLP, FXP, SP> IN <TT, D, R>. WILL ERROR OUT
;;; IF THEY DON'T MATCH UP. USED FOR TRAPPING GROSS
;;; ERRORS IN THE SYSTEM.
PDLCHK: SETZ T,
CAIE TT,(FLP)
MOVEI T,QFLPDL
CAIE D,(FXP)
MOVEI T,QFXPDL
CAIE R,(SP)
MOVEI T,QSPECPDL
JUMPE T,CPOPJ ;EVERYBODY HAPPY?
PDLCRP: MOVEI A,(T) ;NO, PDL CRAP-OUT
LER3 [SIXBIT \OUT OF PHASE (SYSTEM ERROR)!\]
;;; (DEFUN TOP-LEVEL-LINMODE ()
;;; ((LAMBDA (FL)
;;; (COND ((AND (TTYP FL) (STATUS LINMODE FL))
;;; FL)))
;;; (STANDARD-IFILE INFILE)))
;;; SKIP IF INFILE IS IN LINE MODE.
;;; ALSO LEAVE OUTFILES IN AR1 AND READTABLE IN AR2A.
;;; FURTHERMORE LEAVE INPUT FILE IN C (SEE TLPRINT).
;;; ALSO LEAVE TTSAR OF INPUT FILE IN T.
LINMDP: JSP T,GTRDTB
HRRZ C,VINFILE
SKIPE TAPRED
CAIN C,TRUTH
HRRZ C,V%TYI
SKIPE AR1,TAPWRT
HRRZ AR1,VOUTFILES
SFA$ HRLZI TT,AS.SFA ;SFAS ARE NEVER IN LINE MODE
SFA$ TDNE TT,ASAR(C)
SFA$ JRST (F) ;RETURN NON-LINEMODE
XCTPRO
MOVE T,TTSAR(C)
MOVE TT,F.MODE(T)
NOPRO
TLNE T,TTS.TY
TLNN TT,FBT.LN ;ONLY A TTY CAN HAVE LINMODE SET
JRST (F) ;TYPICALLY RETURN TO AN ITERPRI
JRST 1(F) ; OR SKIP OVER IT
;;; (DEFUN READ-EVAL-*-PRINT (OBJ) ;TOP-LEVEL-PRINT
;;; (AND READ-EVAL-*-PRINT
;;; (FUNCALL READ-EVAL-*-PRINT OBJ))
;;; ((LAMBDA (FL)
;;; (COND ((OR (NULL FL) (NOT (EQ (STATUS TTYCONS FL) TYO)))
;;; (TERPRI IFILE)))
;;; (COND (PRIN1 (FUNCALL PRIN1 OBJ)) ('T (PRIN1 OBJ)))
;;; (TYO 32.)) ;<SPACE>
;;; (TOP-LEVEL-LINMODE)))
TLPRINT:
SKIPE C,VTLPRINT ;CHECK FOR USER'S INTERCEPT FUNCTION
CALLF 1,(C)
PUSH P,A ;TOP-LEVEL PRINT
JSP F,LINMDP ;LEAVES INPUT FILE IN C, VOUTFILES in AR1
JRST TLPR1
JSP F,STBIDP ;BI-DIRECTIONAL?
JRST TLPR1 ;NO, SO GO AHEAD AND TERPRI
CAME C,V%TYO ;IF ASSOCIATED CHANNEL IS TYO, THEN DON'T
; OUTPUT THE <CR> SINCE ECHOING WILL DO
TLPR1: PUSHJ P,ITERPRI
TLPR1A: MOVE A,(P)
PUSHJ P,IPRIN1
MOVEI A,40
PUSHJ P,TYO
JRST POPAJ
IPRIN1: SKIPN V%PR1
JRST PRIN1
JCALLF 1,@V%PR1
;; FOR A "BI-DIRECTIONAL" STREAM, GET THE "ASSOCIATE" STREAM INTO C
;; FOR TTYS, THIS IS JUST (STATUS TTYCONS)
STBIDP: HRLZI TT,AS.SFA
TDNE TT,ASAR(C) ;ENTER WITH STREAM IN C
JRST [ MOVEI TT,SR.CNS ;IF SFA, THEN GET THE TTYCONS SLOT
HLRZ C,@TTSAR(C)
JRST STBD1 ]
MOVE T,TTSAR(C) ;PICK UP THE TTSAR
TLNN T,TTS.TY
JRST (F) ;PLAIN EXIT, NO SKIP, FOR NON-BI
MOVEI TT,FT.CNS
HRRZ C,@T ;PICK UP FT.CNS FROM TTY FILE ARRAY
STBD1: JUMPN C,1(F) ; AND EXIT BY SKIPPING 1, IF TTYCONS EXISTS
JRST (F)
;;; TOP LEVEL VARIABLE SETTINGS
TLVRSS: MOVE A,[PNBUF,,PNBUF+1]
SETZM PNBUF
BLT A,PNBUF+LPNBUF-1
TLVRS1: PUSH P,EOFRTN
MOVE A,[ERRTN,,ERRTN+1]
SETZM ERRTN
BLT A,ERRTN+LEP1-1
SETOM ERRSW
POP P,EOFRTN
SETZB NIL,PANICP
SETZB A,PSYMF
SETZB B,EXPL5
SETZB C,PA3
SETZB AR1,RDLARG
SETZB AR2A,QF1SB
SETZM ARGLOC
SETZM ARGNUM
JRST (T)
IFN D10,[
SIXJBN: PJOB TT,
IDIVI TT,100.
IDIVI D,10.
LSH TT,14
LSH D,6
ADDI TT,(D)
ADDI TT,202020(R)
HRLI TT,(SIXBIT /LSP/)
MOVSM TT,D10NAM ;SAVE ###LSP AS TEMP FILE NAME
POPJ P,
] ;END OF IFN D10
SUBTTL INITIALIZATION ON ↑G QUIT AND ERRORS
;;; ERINIT RESETS PDL POINTERS, THEN FALLS INTO ERINI0.
;;; ERINI0 RESETS VARIOUS VARIABLES AND PERFORMS CLEANUP.
ERINIT:
;DISABLE INTERRUPT SYSTEM
10$ SA% MOVE P,C2
10$ SA% MOVE FXP,FXC2
PIPAUSE ;DISABLE ALL INTERRUPTS
ERINIX: ;ENTER HERE IF INTERRUPTS ALREADY DISABLED
IFE PAGING*<1-SAIL>,[
MOVE P,C2 ;SET UP PDL POINTERS
MOVE FXP,FXC2
MOVE FLP,FLC2
MOVE SP,SC2
] ;END OF IFE PAGING*<1-SAIL>
IFN PAGING,[
HRRZ T,LISPSW
CAIE T,LISP
JRST ERINI9
IFE SAIL,[
MOVE T,[$NXM,,QRANDOM]
MOVE TT,PDLFL2 ;CONTAINS <- # OF PDL SEGS,,# OF 1ST PDL SEG>
MOVEM T,ST(TT) ;UPDATE SEGMENT TABLE TO REFLECT
AOBJN TT,.-1 ; LOSS OF PDL PAGES
HRRZ T,PDLFL1
ROT T,-4
ADDI T,(T)
ROT T,-1
TLC T,770000
ADD T,[450200,,PURTBL]
SETZ D,
HLRE TT,PDLFL1
ERINI8: TLNN T,730000
TLZ T,770000
IDPB D,T
AOJL TT,ERINI8
IT$ MOVE T,PDLFL1 ;CONTAINS <- # OF PDL PAGES,,# OF 1ST PDL PAGE>
IT$ .CALL PDLFLS ;FLUSH ALL PDL PAGES
IT$ .VALUE
20$ WARN [SHOULD TWENEX FLUSH PDL PAGES??]
10$ WARN [SHOULD TOPS-10 FLUSH PDL PAGES??]
] ;END OF IFE SAIL
ERINI9:
IRP Z,,[P,FLP,FXP,SP]
MOVEI F,Z
MOVE Z,C2-P+Z ;CAUSE ONE PDL PAGE
MOVEI D,1(Z) ; FOR Z TO EXIST
ANDI D,PAGMSK ;BUT FOR SAIL, MAKE ALL EXIST
SA$ MOVE TT,D
JSR PDLSTH .SEE PDLST0
SA$ MOVEI D,PAGSIZ(TT)
SA$ CAMGE D,XPDL-P+Z
SA$ JRST .-4
TERMIN
ERIN8G: MOVE T,[XPDL,,ZPDL]
BLT T,ZSPDL
] ;END OF IFN PAGING
ERINI0: SETZB NIL,TAPRED ;INITIALIZATION AFTER PDL SETUP
SETZM NOQUIT
SETZM REALLY
SETZM FASLP
IFN USELESS, SETZM TYOSW
SETZM INTFLG
SETZM INTAR
SETZM VEVALHOOK
SETZM GCFXP ;NON-ZERO WOULD MEAN INSIDE GC
SETZM BFPRDP
MOVE T,[-LINTPDL,,INTPDL]
MOVEM T,INTPDL
MOVEI T,$DEVICE ;RESTORE READER'S LITTLE MEN
MOVEM T,TYIMAN
MOVEI T,IUNTYI ;INTERNAL UNTYI'ER
MOVEM T,UNTYIMAN
;FALLS THROUGH
;FALLS IN
ERINI2: SKIPL MUNGP ;MAYBE NEED TO UNMUNG SYMBOLS AND SARS
JRST ERINI6
MOVE D,SYSGLK
ERINI5: JUMPE D,ERIN5A
MOVEI F,(D)
LSH F,SEGLOG
HRLI F,-SEGSIZ
LDB D,[SEGBYT,,GCST(D)]
ERIN5C: MOVSI R,1
ANDCAB R,(F) ;UNMUNGS THE SYMBOL HEADER, IF NECESSARY
HLRZS R
HRRZ R,(R) ;GET ADDR OF VALUE CELL
CAIL R,BVCSG
CAIL R,BVCSG+<NXVCSG+1>*SEGSIZ
JRST .+2
JRST ERIN5D
CAIL R,BPURFS
CAIL R,PFSLAST
JRST .+2
JRST ERIN5D
HRRZS (R) ;UNMUNGS THE VALUE CELL, IF STORED IN LIST SPACE
ERIN5D: AOBJN F,ERIN5C
JRST ERINI5
ERIN5A: MOVE F,[SARTOB,,B]
BLT F,LPROGZ
MOVE D,SASGLK
ERIN5B: JUMPE D,ERINI6
MOVEI F,(D)
LSH F,SEGLOG
HRLI F,-SEGSIZ/2
LDB D,[SEGBYT,,GCST(D)]
JRST SATOB1
ERINI6: HRRZS MUNGP
SKIPN MUNGP ;UNMUNG VALUE CELLS (SEE ALIST)
JRST ERIN6A
MOVEI F,BVCSG
SUB F,EFVCS
HRLI F,(F)
HRRI F,BVCSG
HRRZS (F)
AOBJN F,.-1
SETZM MUNGP
ERIN6A: MOVE B,[ERRTN,,ERRTN+1]
SETZM ERRTN
BLT B,UIRTN
SETOM ERRSW
MOVSI B,-NSFC
ERINI3: MOVE C,SFXTBI(B) ;RESTORE CLOBBERED LOCATIONS
MOVEM C,@SFXTBL(B)
AOBJN B,ERINI3
TLZ A,-1
;ENABLE THE INTERRUPT SYSTEM
IFN ITS,[
.SUSET [.SMASK,,IMASK] ;RESTORE INTERRUPT ENABLE MASKS
.SUSET [.SMSK2,,IMASK2]
.SUSET [.SDF1,,R70] ;RESET DEFER WORDS
.SUSET [.SDF2,,R70]
] ;END OF IFN ITS
PIONAGAIN
JRST (A) ;RETURN TO CALLER
SARTOB: ;TURN OFF MARK BITS IN SARS
OFFSET B-.
SATOB1: ANDCAM SATOB7,TTSAR(F)
AOBJP F,ERIN5B
AOJA F,SATOB1
SATOB7:
TTS<GC>,,
LPROGZ==.-1
OFFSET 0
.HKILL SATOB1 SATOB7
PDLFLS: SETZ
SIXBIT \CORBLK\
1000,,0 ;DELETE PAGES...
1000,,-1 ; FROM MYSELF...
SETZ T ; AND HERE'S HOW MANY AND WHERE!
SUBTTL SPECIAL VARIABLE BINDING AND UNBINDING ROUTINES
JFCL ;HISTORICAL LOSS -- EVENTUALLY FLUSH
SPECBIND: MOVEM SP,SPSV ;0 0,FOO MEANS FOO IS ADDR OF SVC TO BE BOUND TO NIL, SAVES D
SPEC1: LDB R,[271500,,(T)] ;0 N,FOO MEANS SVC FOO TO BE BOUND TO CONTENTS OF ACC N
JUMPE R,SPEC4
CAILE R,17 ;7←41 M,FOO MEANS BIND FOO TO -M(P)
JRST SPEC3 ;OTHERWISE, IS PDP10 INSTRUCTION, SO EXIT
SPEC2: HRRZ R,(R) ;NOTE WELL! NCOMPLR DEPENDS ON THE FACT
CAML R,NPDLL ; THAT R = TT+2 = NUMVALAC+2
CAMLE R,NPDLH
JRST SPEC4
PUSH FXP,T
MOVEI T,(R)
LSH T,-SEGLOG
SKIPL T,ST(T) ;NMK1 WILL WANT TYPE BITS IN T
TLNN T,$PDLNM ;SKIP IF PDL NUMBER
JRST SPEC5
HRR T,(FXP)
LDB R,[271500,,(T)] ;RECOMPUTE ADDRESS OF FROB
CAIG R,17
JRST SPEC6
TRC R,16000#-1
ADDI R,1(P)
SPEC6: PUSHJ P,ABIND3 ;TEMPORARILY CLOSE THE BIND BLOCK
PUSH P,A
HRRZ A,(R)
PUSHJ P,NMK1
MOVEM A,(R) ;CLOBBER LOC OF FROB WITH NEW NUMBER
CAIN R,A ;GRUMBLE
MOVEM A,(P)
SUB SP,R70+1 ;SO RE-OPEN THE BIND-BLOCK
MOVEI R,(A) ;THEREBY INHIBITING INTERRUPTS
POP P,A
SPEC5: POP FXP,T
IFN D10,[
SPEC4: PUSH FXP,T
MOVEI T,@(T)
CAIN T,PWIOINT
JRST [ POP FXP,T
JRST WIOSPC]
EXCH R,(T)
POP FXP,T
] ;END IFN D10
10% BNDTRAP SPEC4,WIOSPC,T, EXCH R,@(T)
SPEC4A: HRL R,(T)
PUSH SP,R
AOJA T,SPEC1
SPEC3: CAIGE R,16000
JRST SPECX
TRC R,16000#-1 ;RH OF R NOW HAS N
ADDI R,1(P) ;SPECBINDING OFF PDL
JRST SPEC2
ERRPOP: POP FXP,ERRPAD ;POP RETURN ADR OFF FXP
MOVE TT,C2 ;RUN ALL OF THE UNWIND HANDLERS
MOVEM T,ERRPST ;SAVE T
PUSHJ FXP,UNWPRO
MOVE T,ERRPST ;RESTORE SAVED T
PUSH P,ERRPAD ;SAVE ERR RETURN ADR
;ENTRY POINT IF NO UNWIND-PROTECT FUNCTIONS SHOULD BE RUN
ERRPNU: SKIPA TT,ZSC2 ;TOTALLY POP OFF SPECPDL FOR ERRORS
UBD0: TLZA TT,-1 ;POP SPECPDL TO PLACE SPECIFIED IN TT
SETOM (TT) ;ERRPOP MUST SETOM - SEE UBD4
UBD: CAIL TT,(SP) ;RESTORE THE SPDL BY RESTORING VALUES
JRST UNBND2 ; UNTIL (SP) MATCHES (TT)
POP SP,R
HLRZ D,R
TLZ R,-1
CAMGE R,ZSC2
JRST UBD3
CAIG R,(SP)
JRST UBD4
SKIPN D
.LOSE ;Somebody screwed the SPECPDL - HELP!!!
BNDTRAP UBD3,UBDP,D, HRRZM R,(D)
UBD1: JRST UBD
UBDP: PUSH FXP,T ;Figure out if WITHOUT-INTERRUPTS
HRRZI T,(D)
CAIN D,PWIOINT ;WITHOUT-INTERRUPTS, handle specially
JRST UBDWIO
POP FXP,T ;Restore state
HRRZM R,(D) ;Recause error, will trap this time
JRST UBD ;Continue if continued
UBDWIO: PUSH P,[WIOUNB] ;Make sure without-interrupt'er gets called
POP FXP,T
PUSH FLP,R ;With old value to store
MOVSS (FLP) ;WIOUNB expects it in left half
JRST UBD
UBD4: HLRZ D,(SP)
JUMPN D,UBD ;AMONG OTHER THINGS, ERRPOP'S SETOM MAKES THIS JUMP
PUSH FLP,T ;MUST SAVE T
MOVEI T,(R)
PUSHJ P,AUNBN0 ;FOUND A FUNARG BINDING BLOCK
POP FLP,T ; - USE SPECIAL ROUTINE TO UNBIND IT
JRST UBD
UNBIND: POP SP,T
MOVEM TT,UNBND3 ;HORRIBLE HACK TO SAVE AC TT. THINK ABOUT THIS SOME DAY
UNBND0: TLZ T,-1 ;AUNBIND ENTERS HERE
IFE D10,[
UNBND1: CAIN T,(SP)
JRST UNBND2
POP SP,TT
MOVSS TT
BNDTRAP ,UNBNDP,TT, HLRZM TT,(TT)
JRST UNBND1
]; END IFE D10,
IFN D10,[
PUSH FXP,R ;Save R for comparison (Can't use FLP -- used to pass
; an argument to WIOUNB)
MOVEI R,PWIOINT ;For comparison, factored out of the loop
UNBND1: CAIN T,(SP) ;End of looop?
JRST UNBD2A
POP SP,TT
MOVSS TT
CAIN R,(TT) ;Is this the special case PWIOINT?
JRST UNBNDP ; Yes, hack it
HLRZM TT,(TT)
JRST UNBND1
]; END IFN D10,
UNBNDP: PUSH FXP,T ;FIGURE OUT IF WITHOUT-INTERRUPTS
HRRZI T,(TT)
CAIN T,PWIOINT ;WITHOUT-INTERRUPTS, HANDLE SPECIALLY
JRST UNBWIO
POP FXP,T ;RESTORE STATE
HLRZM TT,(TT) ;RECAUSE ERROR, WILL TRAP THIS TIME
JRST UNBND1 ;CONTINUE IF CONTINUED
UNBWIO: PUSH P,[WIOUNB] ;MAKE SURE WITHOUT-INTERRUPT'ER GETS CALLED
POP FXP,T
PUSH FLP,TT ;WITH OLD VALUE
JRST UNBND1
;;; BIND, AND MAKE-VALUE-CELL ROUTINES.
;;; PUSHJ P,BIND WITH SYMBOL IN A, VALUE IN AR1.
;;; USES ONLY A, TT; MUST SAVE T
;;; JSP TT,MAKVC WITH AN ATOMIC SYMBOL ON THE PDL (WHICH IS POPPED)
;;; AND THE VALUE IN B. RETURNS ADDRESS OF NEW VALUE CELL IN A.
;;; (LATTER CROCK FOR BIND1 ONLY). USES ONLY A,B,TT.
BIND: SKIPN TT,A
JRST BIND5
HLRZ A,(A)
XCTPRO
HRRZ A,(A)
NOPRO
CAIN A,SUNBOUND
JRST BIND1
BIND4: PUSH SP,(A)
HRLM A,(SP)
BNDTRAP STQPUR,WIOBND,A, HRRZM AR1,(A)
POPJ P,
BIND5: MOVEI A,VNIL ;ALLOW PURPGI TRAP TO WORK JUST
CBIND4: JRST BIND4 ;LIKE FOR SETQING T
BIND1: PUSH P,CBIND4 ;SET UP FOR CALL TO MAKVC
PUSH P,B
PUSH P,TT
MOVEI B,QUNBOUND
JSP TT,MAKVC
POPBJ: POP P,B
CPOPBJ: POPJ P,POPBJ
MAKVC: PUSH FXP,TT ;SAVE RETURN ADDR
SPECPRO INTZAX
MAKVC0: SKIPN A,FFVC
JRST MAKVC3
EXCH B,@FFVC
XCTPRO
HRRZM B,FFVC
NOPRO
MAKVC1: HLRZ B,@(P) ;POINTER TO SYMBOL HEADER IS ON STACK
PURTRAP MAKVC9,B, HRRM A,(B)
MAKVCX: SUB P,R70+1 ;POP POINTER, RETURN ADDRESS OF VALUE CELL
POPJ FXP, ; IN A, ADDR OF SY2 BLOCK IN B
IFE PAGING,[
MAKVC3: PUSHJ P,CONS1
SETOM ETVCFLSP
JRST MAKVC1
] ;END OF IFE PAGING
SUBTTL VARIOUS ODDBALL CONSERS
IFN BIGNUM,[
C1CONS: EXCH T,YAGDBT
JSP T,FWCONS
EXCH T,YAGDBT
JRST ACONS
] ;END OF IFN BIGNUM
%NCONS: PUSH P,T
NCONS: TLZ A,-1
BAKPRO
ACONS: SKIPN FFS ;THIS IS A CONS LIKE XCONS
PUSHJ P,AGC ;BUT USES ONLY ACCUMULATOR A
MOVSS A ;SWAP HALVES OF A, THEN
SPECPRO INTACX
EXCH A,@FFS ;CONS WHOLE WORD FROM A
XCTPRO
EXCH A,FFS
NOPRO
POPJ P,
IFN BIGNUM,[
BAKPRO
BGNMAK: ;MAKE A POSITIVE BIGNUM (SAME AS BNCONS)
BNCONS: SKIPN FFB ;BIGNUM CONSER
PUSHJ P,AGC
EXCH A,@FFB
XCTPRO
EXCH A,FFB
NOPRO
POPJ P,
] ;END OF IFN BIGNUM
;;; EXPLODEC ARGUMENT IN A (WITH BASE=10., *NOPOINT=T),
;;; AND RETURN A SIXBIT WORD IN TT. CLOBBERS ALL ACS.
SIXMAK: MOVEI B,IN0+10.
JSP T,SPECBIND
0 B,VBASE
0 B,V.NOPOINT
SETZM SIXMK2
MOVE AR1,[440600,,SIXMK2]
HRROI R,SIXMK1 .SEE PR.PRC
PUSHJ P,PRINTA ;CALL PRINTA TO EXPLODEC THE ARGUMENT
MOVE TT,SIXMK2
JRST UNBIND
SIXMK1: CAIGE A,140 ;THIS SAYS CONVERT LOWER CASE TO UPPER
TRC A,40 ;CONVERT CHAR TO SIXBIT
TLNE AR1,770000
.UDT4: IDPB A,AR1 ;MAYBE SAVE IT, UNLESS ALREADY HAVE SIX
POPJ P,
;;; TAKE SIXBIT IN TT, RETURN AN ATOMIC SYMBOL IN A.
;;; EMBEDDED BLANKS COUNT, BUT TRALING ONES DON'T.
;;; A ZERO WORD BECOMES THE ATOM "*". SAVES F.
SIXATM: SETOM LPNF
MOVE C,PNBP
MOVSI T,(ASCII \*\)
MOVEM T,PNBUF
SETZM PNBUF+1
SIXAT1: JUMPE TT,RINTERN ;RINTERN SAVES F
SETZ T,
LSHC T,6
ADDI T,40 ;CONVERT SIXBIT TO ASCII
IDPB T,C ;STICK CHARACTERS IN PNBUF
JRST SIXAT1
;;; A STRING IS IN PNBUF, TERMINATED BY A NULL.
;;; LOCATE ITS END, AND CALL RINTERN TO MAKE AN ATOM.
PNBFAT: MOVE T,PNBP
PNBFA1: MOVE C,T
ILDB TT,T
JUMPN TT,PNBFA1
SETOM LPNF
JRST RINTERN
;;; TAKE AN S-EXPRESSION IN A, AND EXPLODEC IT INTO PNBUF.
;;; AR2A WILL CONTAIN THE COUNT OF UNUSED CHARACTER POSITIONS IN PNBUF.
;;; PRESERVES ITS ARGUMENT.
PNBFMK: PUSH P,A
PUSH P,CPOPAJ
SETZM PNBUF
MOVE T,[PNBUF,,PNBUF+1]
BLT T,PNBUF+LPNBUF-1
MOVE AR1,PNBP
MOVEI AR2A,LPNBUF*BYTSWD
HRROI R,PNBFM6 .SEE PR.PRC
JRST PRINTA
PNBFM6: JUMPLE AR2A,CPOPJ ;GIVE UP IF NO MORE ROOM IN PNBUF
IDPB A,AR1 ;ELSE STICK CHARACTER IN
SOJA AR2A,CPOPJ
IFN D10,[
;;; CONVERT A PPN IN TT TO AN "ATOM", I.E. AN S-EXPR OF APPROPRIATE FORM. SAVES F.
PPNATM:
IFE SAIL,[
SKIPN CMUP
JRST PPNAT2
HLRZ T,TT
CAME TT,[-1]
CAIG T,10 ;PPN'S WITH PROJECT BETWEEN 1 AND 10
JRST PPNAT2 ; MUST BE EXPRESSED IN DEC FORM
MOVE T,[TT,,PNBUF]
SETZM PNBUF+1 ;NEED THIS BECAUSE OF CMU BUG
DECCMU T, ;TRY CONVERTING PPN TO CMU STRING
JRST PPNAT2 ;ON FAILURE, JUST REVERT TO DEC FORMAT
JRST PNBFAT ;ON SUCCESS, CONS UP ATOM FROM STRING
] ;END OF IFE SAIL
PPNAT2: JUMPN TT,. 3
MOVEI A,Q.
POPJ P,
PUSHN P,1
PUSH FXP,TT
TLZ TT,-1
PUSHJ P,PPNAT4 ;CONVERT PROGRAMMER
POP FXP,TT
HLRZS TT
PUSHJ P,PPNAT4 ;CONVERT PROJECT
JRST POPAJ
PPNAT4:
IFE SAIL,[
CAIN TT,-1 ;777777 => OMITTED HALF OF PPN
SKIPA A,[Q.] ;REPLACE IT WITH *
JSP T,FXCONS ;OTHARWISE USE A FIXNUM
↓MOVE B,-1(P)
PUSHJ P,CONS
MOVEM A,-1(P)
POPJ P,
] ;END OF IFE SAIL
IFN SAIL,[
CAIN TT,-1 ;777775 => OMITTED HALF OF PPN
JRST PPNAT9 ;REPLACE IP WITH *
JUMPE TT,PPNAT9 ;? MIGHT AS WELL TREAT 0 AS OMITTED
PPNAT6: TLNE TT,770000 ;HEFT JUSTIFY THE SIXBIT @π⊃β%¬π) %L~∀αA)%'(AA!≥β(L∩∩w∂! ≤A =≥
XA
% β)∀Aβ≤A¬)∨~A¬≥Aπ=→&A∨9)≡A→%'(~∀%→'⊂AQ(Xl~(∪∃%'PA!!≥¬(l~∃t∩∩w 9λA∨ ↓∪
≤AMβ∪_~(~∃'α⊂A!!≥¬(rt∪M↔∪!α↓αY7"9:~∃!A≥β(fh~∀d`∀∪!+'!∀A YM∪1β)4~∀d`⊂∪!+'!∀A YA≥¬
βP~∃!!9β(jT%≠∨-
↓∧XZb! R
∀%!+'⊃(A Yπ=≥&~∀%≠∨- 4AαXZDQ R~(∪!∨!(A X~):∩∩w∃≥A∨_A∪
≤↓λb`~(_∩¬'U¬))_%ββ)π XA)⊃I≠&XA∃%%' PX@]'∃(XAβ9λA¬%∃β⊗A%=+)β≥∃&~∀~(w∃∨%5β_Aπ¬)π⊂~)πβ)!U&t∪!U'⊂A 1∧∩∩w
≠≠!∪1 λAπ= αA
=$@Eπ¬)π⊂A∃≥) %LA⊃ %∀~∀∪≠=) ∩A∧XQαR$∩vAπ=≠!→$↓)+%≥L@EπβQπ⊂DAQ~@DU
β)π⊂λ~∀β≠=) ∩APXQαR4∀∪→' A(X[M ∂→∨≤~∀∪'-∪!∂
↓'(Q($∩∩w'∃
Aβ ↓)β∞A=$A)β≥→∪'(4∀∩@A!%→∩A∧Yπβ)M!π9π¬)→∪&4∃πβ)A&bt∪5∨- ~↓αYπβQ∪λ∩∩m' (AU AαA
β)π⊂↓
%β≠∀~∀∪∃M A(Y∃%') 4∀∪≠∨Y ~A 1πβ)%Q≤~∀∪)%'(@!)(R~(~∀wπ¬)π⊂[ β%%∪∃$~∃π¬)¬β$h∪!+' A Y∧$∩wβ HA)≡A)+≠ AQ≡A/⊃∃≤A)⊃I∨.A∪LA ∨≥∀~∀∪⊃I→∩Aα1ββ)'Aπ9πβQ→∪'9
β)πβλ@w
→¬∞Aβ&↓πβ)π [¬β%I∪ $~(∪≠∨-∃~AαY
β)∪λ$∩w)⊃%&A∪&↓)⊃
A
β)π⊂↓∪λ~∀%∃' APY %'Q ∩∩wM )+ ↓αA≥ \Aπβ)
⊂A
%­
~∀%≠∨- 4A Yπ¬)%)≤4∀∪∃%M(@Q)PR~∀~(wπβ)
⊃β→_4∀vA+A∨≤A 9)%2t↓)(A⊃¬&Aβ HZbA∨_Aπβ)
⊃β→_↓
+≤X↓(A⊃βLAβ $↓β
) HA∨)⊃∃$A
+9&~∃πQπβ→_h∪!+' A Y(4∀∪β∨LA)(∩$∩w!∨%≥(A)<A
∪%M(A→∨
β)∪∨8A∨ A
β)π⊃¬→_A
U≤~∀∪!%→∩AQ(YπβQ'!π9
β)β→19πβ)
∨~@w→→β∞A¬&AαA
∨≠!∪1 λAπ¬)π⊃β1_~∀∪5∨- ~↓)(Yπ¬)∪λ∩$w)⊃∪LA∪&AQ⊃αAπ¬)π⊂A%λ~∀∪)' A(1 %')@∩∩w'∃)+ A∧A≥ .↓πβ)π A
%β5
~∀∪5∨- ~↓ YπβQ%)≤~(∪∃%'P@ZbQQ(R~∀4∀w¬%∃β↔+ ↓αAπβQβ⊃β→0~∃)⊃Iβ→_t%' )54@Q R$∩w)+I≤A∪≥Q≡AαA9∨%≠β0Aπβ)
⊂~∀∪)%'(AQ⊃%∨.D∩∩w)! ≤A¬I β⊗AU A→∪-
AαA9∨%≠β0A)⊃%=.~∀~))⊃%∨\jt∪'-∪!
A⊂Y+∪%Q≤∩∩w% A≥≡↓+' $↓∪≥) I%+!(↓
%β≠∀A')β
↔ λX4∀∩Aπ¬∪∞Aλ0Q)(R$∩vA∨HA∪ A%(A∪&↓¬ →∨\A)⊃
↓πβ)π A
%β5
X~∀$@A∃%M(A)⊃I∨.f∩$vA)⊃∃≤A∃+M(A 1%(A)⊃∀Aπβ)
⊂A
%­
~∀%∃' AQ(Y+∪ %⊗∩∩m∨)⊃ I/∪'
↓¬% β,A∨+(↓∨ A)!
A∪≥Q %%+A(~∃)!%∨.bh∪'↔∪A≤A)(1πβ)%Q≤∩∩wM↔∪ A% AπβQπ⊂A
Iβ≠
A →∨.↓+&~∀$A∃%'PA)⊃%=.h~∀%≠∨-'$A(Yπ¬)+/ 4∀∪) 9
A(X!)(R∩$w+≥/%≥λ[!I∨) πPA
%β5
}~∀$A∃%'PA)⊃%91(∩∩m3 &X↓'↔∪ ↓∪(Aπ=≠!→ Q →2~(∪∃+≠A
A∧YQ⊃%∨.T~∃)⊃I∨.lt%'↔∪!8A(XQQ(R∩∩lQπβ)
⊂A
∨<A≥∪_$@z@Q
β)π⊂↓
∨≡R4∀∩A∃I'(A)!%∨.j$∩wπβQπ⊂A∪⊂A≠β)
⊃ &AQ⊃%∨.↓∪λ~∀%)→≥
↓(YπβQ'!ε∩$w'!
∪β_AA%∨π M'∪≥∞↓≥ ∃λ}~∀$A∃%'PA)⊃%M!ε∩∩m3 &X↓ ≡A'<~∀∪π¬∪≤A∧0Q(R∩$wπβ)
⊂A∪λ↓≠β)π! &}~(∩A∃%M(A)⊃I∨.j∩$w3 &4∃)⊃%91(t∪5∨-
AQ(Xx[1 bVD|Vyπ¬)%)≤5 %%)8|Q)($∩w∂≡↓¬βπ⊗↓∨≥
A
β)π⊂4∀∪∃+5!≤A)PY)⊃%=.l∩∩m
β→_↓)⊃%∨U∂⊂A∪_A≥≡A5∨%
~))⊃%∨\htA∃U≠!
AλY→'!I (∩∩m∪ A)¬∞A∪&PRXAQ⊃ ≤A)+'(AQ⊃%∨.↓)≡~∃Q⊃%∨.\t∪ 1
⊂AαYλ∩∩w)=!→ -∃_vA∨Q⊃β%/%'
XA∃%%∨$4∀∩K+≥(A ≠Ldr~∀% 1π⊂↓αY∧~(∪∃%'PA)⊃%=.b~∀4∀~∃)!%∨.fh∪!+'!∀A
1@Y+≥/A%≡∩wU≥/∪≥⊂A!%∨Q π(A
⊃ π↔∃$~∀∪5∨-
A@Y)(~))⊃%1%(t∪'∃)5~AAβ≥∪π@~∀β≠=-'αA⊂X[→ @bVbQ@R~∀∪!%%∩A⊂Y %%Q_~∀∪ →(Aλ1 %%)8W→ DZb~∀%≠∨-
↓εYπβQ∪λ∩∩m∂ (A
+%% 9(AπβQ∞!αL 4(&≥* αAd*B
DhP&B>ααA2~E4(&∧zAαAd22@4PJB>A¬↓2RPhP&B>ααA2B _4(&¬*N")¬↓2V
!$%n∀*NR>∀)α∞>t"&R&|rMαεt!αBJ|~⊗⊗⊂hP&R2tqα
2≤
Rε2`H%n¬∧~εR∞D
21|hP%αB⎇α)αA`H%n:⎇α∃1α∀*RVJrαR"J⎇:9αZ bV∀4PJ⊗b∞Bα¬2λHInRε:αεMα4JJNQ∧
J≥1¬2ε1α
→αN⊗≤z:4PJR2:*α
2∞
"∞>4HIn∞≡mα&2⊗#x4(¬∧RJNQαB
$$KZf⊗MbαJV9∧~>&BLb⊗⊃α≤z∩∀4PJεε2d1↓I1D→$$%\*2N∃∧~ε2⊃¬""¬α-~⊗I≡~α~V:≥"&>8hP&B>∧QαA⊂HH%nJ-"VJ9∧r⊗]α4
1α&2αR"∃∧~εR∞D
21α5*9αJ-"VJ:_h(4*$BJNB≠P&R2t)αQ∩≤
Rε2`H%n∞
"≤D→ICxh!∀∧U∃:@¬$E)zs(H↔;∀-~D
t*∧λ~d*∧izTt"λ∀∧<|xD∧5∀→XR¬$TOP AT
TLNE T,CATUWP ;UNWIND-PROTECT?
JRST THRNXT ;YES, IGNORE THE FRAME
TLNE T,CATCAB ;CATCH-BARRIER?
JRST THRCAB
TLNN T,CATLIS ;A LIST OF TAGS?
LERR [SIXBIT\SPECIAL CATCH FRAME, BUT NO VALID TYPE BITS EXIST!\]
PUSH P,A
PUSH P,B ;SAVE NEEDED ACS
MOVEI A,(B) ;CATCH TAG
MOVEI B,(T) ;LIST OF TAGS
PUSHJ P,MEMQ1 ;CHECK FOR MEMBERSHIP (DOES NOT DESTROY TT)
MOVE T,A ;SAVE THE RESULTS
POP P,B
POP P,A
JUMPE T,THRNXT ;UPWARD TO NEXT CATCH FRAME
JRST THROW5 ;ELSE FOUND A MATCH, SO DO THE ACTUAL THROW
THRCAB: PUSH P,A
PUSH P,B ;SAVE NEEDED ACS
MOVEI A,(B) ;CATCH TAG
MOVEI B,(T) ;LIST OF TAGS
PUSHJ P,MEMQ1 ;CHECK FOR MEMBERSHIP (DOES NOT DESTROY TT)
MOVE T,A ;SAVE THE RESULTS
POP P,B
POP P,A
JUMPE T,THROW7 ;CATCH-BARRIER, NOT IN LIST OF TAGS, ERROR
JRST THROW5 ;ELSE FOUND A MATCH, SO DO THE ACTUAL THROW
JRST THRALL ;COMPILED REMOVAL OF A CATCHALL
JRST THROW1 ;COMPILED THROWS COME HERE
ERUNDO: SKIPN ERRTN ;COMPILED ERR, AND NORMAL ERRSET EXIT COME HERE
JRST LSPRET ;RETURN TO TOPLEVEL
ERR0:
IFN USELESS, SETZM TYOSW
JUMPN A,ERUN0 ;ELSE, BREAK UP AN ERRSET
SKIPE V.RSET
SKIPN VERRSET ;ERRSET BEING BROKEN BY AN ERROR
JRST ERUN0
PUSH P,A
MOVEI D,1001 ;ERRSET USER INTERRUPT
PUSHJ P,UINT
POP P,A
JRST ERUN0
SKIPA TT,CATRTN ;PHOOEY, COMPILED CODE COMES HERE WHEN A
GOBRK: MOVE TT,ERRTN ;GO OR RETURN OCCURS WITHIN AN ERRSET OR CATCH
JUMPE TT,ER4
EXCH T,-LERSTP(TT)
JRST ERR1
IOGBND: JSP T,SPECBIND ;BIND ALL I/O CONTROL VARIABLES TO NIL:
TTYOFF ; ↑W
TAPRED ; ↑Q
TAPWRT ; ↑R
EPOPJ: POPJ P, .SEE $ERRFRAME
;;; MOVEI D,LOOP ;ROUTINE TO LOOP
;;; PUSHJ P,BRGEN
;;; GENERATES A BREAK LOOP SURROUNDED BY A CATCH AND AN
;;; ERRSET. ERRORS CAUSE THE LOOP TO BE RE-ENTERED.
;;; BRGEN RETURNS WHEN THE LOOP ROUTINE PERFORMS A
;;; THROW TO THE TAG BREAK.
.SEE BREAK
.SEE $BREAK
BRGEN: MOVEI A,QBREAK ;CATCH ID = BREAK
JSP TT,CATPS1 ;SET UP CATCH FRAME
PUSH P,D
PUSH P,. ;RETURN POINT FOR ERROR
JSP T,ERSTP ;SET UP ERRSET FRAME
SETOM ERRSW
MOVEM P,ERRTN
JRST @-LERSTP-1(P) ;CALL RANDOM ROUTINE
;;; BREAK LOOP USED BY *BREAK
BRLP1: PUSH P,FLP
PUSH P,FXP
PUSH P,SP
PUSHJ P,TLEVAL ;EVALUATE FORM READ
MOVEM A,V. ;STICK VALUE IN *
PUSHJ P,TLPRINT ;PRINT VALUE
HRRZ TT,-2(P)
HRRZ D,-1(P)
HRRZ R,(P)
POPI P,3
PUSHJ P,PDLCHK ;CHECK PDL LEVELS
JRST TLTERPRI ;TERPRI IF APPROPRIATE
BRLP: PUSH P,BRLP ;***** BASIC BREAK LOOP *****
SKIPE A,BLF ;IF USER SUPPLIED A BREAK LOOP FORM,
JRST EVAL ; EVALUATE IT (RETURNS TO BRLP)
PUSHJ P,TLREAD ;OTHERWISE READ A FORM
JRST .+4
SETZ AR1, ;ON EOF, LOOP BACK AFTER TERPRING
PUSHJ P,TERP1
JRST .-4
SKIPE VDOLLRP ;IF THE FORM IS EQ TO THE
CAME A,VDOLLRP ; NON-NIL VALUE OF THE VARIABLE ≠P,
JRST BRLP4 ; THEN THAT MEANS RETURN NIL
MOVEI A,NIL
BRLP2: MOVEI B,QBREAK
JRST THROW1 ;ESCAPE FROM BRGEN LOOP
BRLP4: HLRZ B,(A) ;(RETURN <FOO>) MEANS RETURN THE
CAIE B,QRETURN ; VALUE OF FOO
JRST BRLP1 ;OTHERWISE EVAL AND PRINT THE FORM
JSP T,%CADR
BRLP3: PUSHJ P,EVAL
JRST BRLP2
;;; JSP T,.STORE ;USED BY COMPILED CODE
;;; ON CALLING .STORE WE MUST HAVE JUST COMPLETED AN "INTERPRETED"
;;; ARRAY REFERENCE OF SOME KIND, BY PUSHJ'ING INTO THE ARRAY HEADER
;;; AND GOING TO ONE OF THE NDIMX ROUTINES. THIS LEAVES THE SAR
;;; OF THE ARRAY REFERENCED IN LISAR, AND THE INDEX WORD IN R.
;;; A CONTAINS THE VALUE TO STORE INTO THE ARRAY.
.STORE: SKIPN D,LISAR
JRST .STOLZ ;ERROR IF NO ARRAY REFERENCED LATELY
HLL D,ASAR(D)
TLNN D,AS.SX ;WAS IT AN S-EXPRESSION ARRAY?
JRST .STOR2
.STOR0: MOVEI TT,(R) ;YEP, STORE A HALF-WORD QUANTITY
JUMPL R,.STOR1
HRLM A,@TTSAR(D)
JRST (T)
.STOR1: HRRM A,@TTSAR(D)
JRST (T)
.STOR2: TLNN D,AS.FX+AS.FL ;SKIP IF FIXNUM OR FLONUM
IFN DBFLAG+CXFLAG, JRST .STOR4
.ELSE .VALUE
MOVEI F,(T)
TLNN D,AS.FX
JSP T,FLNV1X ;GET FLONUM QUANTITY, WITH SKIP RETURN
JSP T,FXNV1 ;OR MAYBE GET FIXNUM QUANTITY
EXCH TT,R
MOVEM R,@TTSAR(D) ;STORE QUANTITY INTO ARRAY
JRST (F)
IFN DBFLAG+CXFLAG,[
.STOR4: TLNN D,AS.DB+AS.CX ;SKIP IF DOUBLE OR COMPLEX
IFN DXFLAG, JRST .STOR6
.ELSE .VALUE
MOVEI F,(T)
DB$ CX$ TLNN D,AS.DB
DB$ CX$ JSP T,CXNV1X ;GET COMPLEX QUANTITY, WITH SKIP RETURN
DB$ JSP T,DBNV1 ;OR MAYBE GET DOUBLE QUANTITY
DB% JSP T,CXNV1
MOVE T,LISAR
EXCH TT,R
MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
ADDI TT,1
MOVEM D,@TTSAR(T)
JRST (F)
] ;END OF IFN DBFLAG+CXFLAG
IFN DXFLAG,[
.STOR4: TLNN D,AS.DX ;SKIP IF DUPLEX
.VALUE ;IF NOT THAT, THEN ERROR (UNKNOWN ARRAY TYPE)
PUSH P,F
PUSH FXP,R
JSP T,DXNV1
MOVE T,LISAR
EXCH TT,(FXP)
KA MOVEM R,@TTSAR(T) ;STORE QUANTITY INTO ARRAY
KA ADDI TT,1
KA MOVEM F,@TTSAR(T)
KA ADDI DT,1
KIKL DMOVEM R,@TTSAR(T)¬
KIKL ADDA TT,2
POP FXP,@TTSAR(T)
ADDI TT,1
↓MOT¬ ~A⊂Y↓))Mβ$Q($~∀∪!=!∀A 0~∃*∩$s ≥λ↓∨ A∪→≤A 1→→β∞~(_∩∧vlp &*≥↓αQ1u~⊗@%]*N⊗⊃∧∩eα∞|jB&2,!α∞>$(4)M[YαεR|iαR≥¬~⊗AαLqαεIλaαε:"αP∀ JXR¬$t
4-"λIr∧Ldλ∩ph'73@4∃∩⊃$
P3∃(T⊃54jD∪Su∧λQ(⊂$
⊃∪λ
~α`g*∩j,WεBεE↔)Qj≥∧bV!d⊂ K i_FB↔)bj ]∧h*Td⊂(⊗⊂FE∧h∃id%⊂∀⊗!$g⊃∧D]a∩e"⊂*⊂ebiP∀lfa'S⊂$g A, VALUE IN AR1
POP P,A ;THIS CROCKISH IMPLEEMNTATION
EXCH A,AR⊃ ; PERFORMS A SET BY DOINC ASPECBIND,
JRST SETXIT 8εA)⊃∃≤A ∪Mπβ% %≥εA)!
A¬∪9 ∪≥∞↓
%∨~↓' ~∀4∀~∀vlp &*≥↓αRQd2↑*ε≤X$%n⎇⊃α2↑t
∞,4SYel%αα~εbEBa12 26,$KZ>Iαd
bbbBa2F~|x4)m[Yα∞",~.Mα4zIαεrα~NV∃⊃↓"2≥*
I%¬""εQ¬""¬α∀J≡"Q∧rV&
-⊃α>→∧
J≡Vl*:RLhQmmm¬:⊗J∃¬αJ>ZL"⊗⊃⊃∧
:⊃α<*:⊗J
"⊗Mα qαεB¬∩>BJL
R∃ααyd
∧Z*$m∩ _b∧tzE`hS572¬$λT∧4
¬Bα H∃EE ¬∩∧D~4¬$DT D⎇h⊂R*D λ⊃IzH∪∀jXTKλε∀⊃StDλTu0J%T 2←N IS SET IFF GETTING EXACTLY N ARGUMENTS IS ACCEPTABLE.
FWNACK: SETZ T, ;COUNT UP ACTUAL NUMBER OF ARGS
MOVEI D,(A) ;LEAVES NEGATIVE OF NUMBER OF ARGS IN T,
FWNAC1: JUMPE D,LWNACK ; SO CAN FALL INTO LSUBR CHECKER
HRRZ D,(D)
SOJA T,FWNAC1
LWNACK: MOVE D,(TT) ;GET WORD OF BITS
ASH D,(T)
TLNE D,2 ;SKIP UNLESS WNA
JRST 1(TT)
JRST WNAL0 ;GO PRODUCE A WRNG-NO-ARGS ERROR
;;; PUSH CRUFT FOR AN ERRSET/CATCH/READEOF FRAME
;;; BEWARE! THE COMPILER DEPENDS ON THE LENGTH OF THE
;;; ERRSET FRAME BEING A CONSTANT.
ERSTP: PUSH P,PA3 ;"ERRSET" PUSH
PUSH P,SP ;MUST SAVE TT - SEE $TYI
PUSH P,FLP
PUSH P,FXP
REPEAT LEP1, PUSH P,ERRTN+.RPCNT
LERSTP==.-ERSTP ;LENGTH OF ERRSET PUSH
HLL T,UNREAL ;SO WE DECIDED TO PACK BOTH OF "UNREAL"
HLLM T,KMPLOSES(P) ; AND "ERRSW" INTO ONE PDL SLOT
JRST (T)
ERUN0: HRRZ TT,ERRTN ;GENERAL BREAK OUT OF AN ERRSET
SKIPE D,UIRTN
CAIL TT,(D)
JRST ERR1A
JSP TT,UIBRK ;MAYBE BREAK UP A USER INTERRUPT FIRST
JRST ERUN0
ERR1A: HRRZ TT,ERRTN ;WHERE WE ARE UNWINDING TO
PUSHJ FXP,UNWPRO ;HANDLE UNWIND-PROTECT
MOVE P,ERRTN
ERR1: SETZM PANICP
HLL D,KMPLOSES(P) ;SO WE DECIDED TO PACK BOTH OF "UNREAL"
HLLEM D,UNREAL ; AND "ERRSW" INTO ONE PDL SLOT
HRRES KMPLOSES(P)
MOVSI D,-LEP1+1(P)
HRRI D,ERRTN
BLT D,ERRTN+LEP1-1
SUB P,EPC1
POP P,FXP
POP P,FLP
POP P,TT
POP P,PA3
JRST UBD0 ;RESTORE CONDITIONS AND PROCEED
EPC1: LEP1,,LEP1
UIBRK: EXCH D,TT ;UNWIND-PROTECT NEEDS STACK POINTER IN AC TT
PUSHJ FXP,UNWPRO ;HANDLE UNWIND PROTECTION
EXCH D,TT
HRRM TT,-1(D)
HRRO FXP,1(D) ;JUST SET LEFT HALF OF PDL POINTERS
HLRO FLP,1(D) ; TO -1 FOR BIBOP, AND LET PDLOV
HRROI P,-UIFRM(D)
IFN PDLBUG,[
FXPFIXPDL AR1
FLPFIXPDL AR1
PFIXPDL AR1
] ;END OF IFN PDLBUG
MOVEM F,UISAVT-T+F(FXP) ;LET F BE SAFE OVER RESTORATION
MOVEM T,UISAVT(FXP) ;T TOO
MOVEM C,UISAVA-A+C(P) ;C TOO
MOVEM B,UISAVA-A+B(P) ;B TOO
MOVEM A,UISAVA(P) ;A TOO
JRST UINT0X
;THIS ROUTINE FINDS ALL UNWIND-PROTECTS BETWEEN THE CURRENT STACK POSITION
; AND THE DESIRED STACK POSITION (AS FOUND IN TT). IF AN UNWIND-PROTECT IS
; FOUND, THEN:
; A) THE UNWIND-PROTECT STACK FRAME IS POP'ED *WITHOUT UPDATING FXP OR FLP*
; B) SP IS UNWOUND TO THE CURRENT BINDING LEVEL
; C) THE FUNCTION IS CALLED WITH EVERYTHING SAVED
; D) WHEN THE FUNCTION RETURNS, ACS ARE RESTORED AND THE ROUTINE CONTINUES
; SEARCHING FOR THE NEXT UNWIND PROTECT
; WHEN NO MORE UNWIND PROTECTS EXIST IN THE SPECIFIED RANGE OF THE PDL,
; THIS ROUTINE RETURNS TO ITS CALLER, WHICH IS EXPECTED TO RESTORE
; FXP AND FLP (AND POSSIBLY OTHERS) FROM THE STACK FRAME THAT WAS USED TO STOP
; THE UNWIND-PROTECT SEARCH
; CALLED WITH PUSHJ FXP,
; TT CONTAINS LOWEST ADR TO SEARCH
; PRESERVES ALL AC'S
UNWPRO:
;;; AMOUNT OF STUFF THAT GETS PUSHED MUST BE WELL DEFINED, CHANGE UNWPUS
;;; IF IT CHANGES
.SEE UNWPUS
PUSH FXP,D
PUSH FXP,T
PUSH FXP,R
PUSH FXP,TT
;;;
HRRZS TT ;ONLY PDL PART
MOVEI R,(SP) ;CURRENT VALUE OF SP IN CASE NO FRAMES FOUND
UNWPR2: SKIPE D,CATRTN
UNWPR1: CAILE TT,(D) ;HAVE WE GONE TOO FAR?
JRST UNWPRT ;NO MORE FRAMES POSSIBLE, SO RETURN
HRLZI T,CATUWP ;IS THIS AN UNWIND-PROTECT FRAME?
TDNN T,(D)
JRST UNWNXT ;NOT UNWIND-PROTECT, SO SKIP THIS FRAME
HRRO P,D ;RESET PDL, WILL WORK BY PDL OV NEXT PUSH
IFN PDLBUG,[
PFIXPDL T
] ;END IFN PDLBUG
;;; PUSH NOTE
.SEE UNWPUS
PUSH FXP,UNREAL ;FROM THIS POINT ON ALLOW NO USER INT'S
SETOM UNREAL
HRRZM FXP,REALLY
MOVE T,(P) ;GET POINTER TO UNWIND HANDLER
MOVSI D,-LEP1+1(P) ;RESTORE HAS FRAME (SNARFED FROM ERR1)
HRRI D,ERRTN
BLT D,ERRTN+LEP1-1
SUB P,EPC1
POP P,D ;GET OLD FXP
POP P,FLP ;RESTORE FLP
POP P,R ;SAVE LEVEL TO SP UNWIND TO
POP P,PA3
PUSHJ FXP,SAV5 ;SAVE ALL PROTECTED ACS
MOVEI B,(T) ;POINTER TO COMPILED FUNCTION OR LIST
;;; PUSH NOTE
.SEE UNWPUS
PUSHJ P,SAVX5 ;AND UNPROTECTED ONES
HRRI T,(D)
MOVEI TT,(R)
PUSHJ P,UBD0 ;Unwind SP
PUSH FLP,T
SETOI A,
JSP T,SPECBIND
α 0 A,PWIOINT
SETZM REALLY
POP FLP,T
TLNN T,CATCOM ;COMPILED CODE?
JRST UNWNCM ;NOPE, USE PROGN
UNWPUS==:13 ;NUMBER OF PUSHES DONE ON FXP
MOVEI TT,(T)
HRLI TT,-<UNWPUS-1>(FXP);BLT POINTER TO DATA THAT MUST BE MOVED
AOS TT
MOVEI D,UNWPUS-1(TT) ;BLT END POINTER
BLT TT,(D) ;BLT ALL IMPORTANT FXP DATA
HRROI FXP,(D) ;NEW FXP
IFN PDLBUG,[
PUSH P,TT
FXPFIXPDL TT
POP P,TT
] ;END OF IFN PDLBUG
PUSHJ P,(B) ;INVOKE THE UNWINDPROTECTION CODE
SKIPA
UNWNCM: PUSHJ P,IPROGN
PUSHJ P,UNBIND ;UNDO THE NOINTERRUPT PROTECTION
PUSHJ P,RSTX5 ;RESTORE ACS
PUSHJ FXP,RST5
POPI FXP,1 ;FLUSH SAVED UNREAL FROM STACK
JRST UNWPR2
UNWNXT: MOVE D,<-LEP1+1>+<CATRTN-ERRTN>(D) ;GO BACK ONE CATCH
JUMPN D,UNWPR1 ;IF MORE FRAMES TO CHECK THEN GO ON
UNWPRT: POP FXP,TT
POP FXP,R
POP FXP,T
POP FXP,D
POPJ FXP,
SUBTTL VARIOUS COMMON EXITS
CIN0: IN0 ;SURPRISE!
;;; THESE ROUTINES ARE USEFUL FOR CONSING UP LISTS OF NUMBERS
;;; (AS STATUS FUNCTIONS OFTEN DO, FOR INSTANCE).
;;; A CALL TO CONS1FX WILL TAKE A NUMBER IN TT AND MAKE A SINGLETON
;;; LIST OF IT. SUCCESSIVE CALLS TO CONSFX WILL THEN TACK NEW NUMBERS
;;; ONTO THE FRONT OF THE LIST. CONS1PFX AND CONSPFX ARE SIMILAR,
;;; BUT POP THE NUMBER FROM FXP. IN THIS WAY ONE CAN PRODUCE NUMBERS
;;; IN FORWARDS ORDER, PUSHING THEM ON FXP, THEN USE THESE ROUTINES
;;; TO CONS THEM UP IN REVEBSE ORDER, PRODUCING A FORWARDS LIST OF THEM.
CONS1PFX: TDZA B,B
CONS1FX: TDZA B,B
CONSPFX: POP FXP,TT
CONSFX: JSP T,FXCONS
CONSIT: PUSHJ P,CONS
BAPOPJ: MOVEI B,(A)
POPJ P,
;;; OTHER COMMON EXITS
ZPOPJ: TDZA TT,TT ;ZERO TT, THEN POPJ
POPNVJ: JSP T,FXNV1 ;FXNV1, THEN POPJ
CCPOPJ: POPJ P,CCPOPJ ;NOT CPOPJ! WILL SCREW BAKTRACE
0POPJ: SKIPA A,CIN0 ;PUT A LISP FIXNUM 0 IN A AND POPJ
POP2J: POPI P,2 ;POP 2 PDL SLOTS AND POPJ
CPOPJ: POPJ P,CPOPJ .SEE BAKTRACE ;SACRED TO BAKTRACE
POP3J: POPI P,3
POPJ P,
POPAJ1: AOSA -1(P) ;POP INTO A, THEN SKIP RETURN
S1PAJ: POPI P,1 ;POP 1 PDL SLOT, POP INTO A, AND POPJ
POPAJ: POP P,A ;POP A, THEN POPJ
CPOPAJ: POPJ P,POPAJ
POP1J1: AOSA -1(P) ;POP 1 PDL SLOT, THEN SKIP RETURN
POPJ1: AOSA (P) ;SKIPPING POPJ RETURN
POP1J: POPI P,1 ;POP 1 PDL SLOT AND POPJ
CPOP1J: POPJ P,POP1J
M1TTPJ: SKIPA TT,XC-1 ;-1 IN TT, THEN POPJ
POPCJ: POP P,C ;POP C, THEN POPJ
CPOPCJ: POPJ P,POPCJ
UNLKFALSE: TDZA A,A ;UNLOCK INTERRUPTS, RETURNING FALSE (NIL)
UNLKTRUE: MOVE A,VT.ITY ;UNLOCK INTERRUPTS, RETURNING TRUTH (T)
UNLKPOPJ
PX1J: POPI FXP,1 ;FLUSH 1 FXP SLOT, THEN POPJ P,
CPXDFLJ: POPJ P,PXDFLJ
PXDFLJ: HLLZ D,(P) ;POP FXP INTO D, THEN POPJ P,
JRST 2,POPXDJ(D) ; AND RESTORE FLAGS FROM THE P SLOT
POPXDJ: POP FXP,D ;POP FXP SLOT INTO D, THEN POPJ P,
CPXDJ: POPJ P,POPXDJ
SUBTTL VARIOUS COMMON SAVE AND RESTORE ROUTINES
SAV5: PUSH P,A
SAV5M1: PUSH P,B
SAV5M2: PUSH P,C
SAV5M3: PUSH P,AR1
PUSH P,AR2A
CPOPXJ: POPJ FXP,
SAV3: PUSH P,C
SAV2: PUSH P,B
SAV1: PUSH P,A
POPJ FXP,
RST3: POP P,A
POP P,B
POP P,C
POPJ FXP,
RST2: POP P,A
POP P,B
POPJ FXP,
RST1: POP P,A
POPJ FXP,
RST5: POP P,AR2A
POP P,AR1
POP P,C
POP P,B
POP P,A
POPJ FXP,
R5M1PJ: PUSH FXP,CCPOPJ
RST5M1: POP P,AR2A
POP P,AR1
POP P,C
POP P,B
CR5M1PJ: POPJ FXP,R5M1PJ
RST5M2: POP P,AR2A
POP P,AR1
POP P,C
POPJ FXP,
RST5M3: POP P,AR2A
POP P,AR1
POPJ FXP,
SAVX5: PUSH FXP,T
PUSHJ P,SAVX3
PUSH FXP,F
POPJ P,
SAVX3: PUSH FXP,TT
PUSH FXP,D
PUSH FXP,R
POPJ P,
RSTX5: POP FXP,F
POP FXP,R
POP FXP,D
PXTTTJ: POP FXP,TT
POPXTJ: POP FXP,T
POPJ P,
RSTX3: POP FXP,R
RSTX2: POP FXP,D
RSTX1: POP FXP,TT
CPOPNVJ: POPJ P,POPNVJ
SUBTTL VARIOUS KINDS OF FRAME MARKERS
$ERRFRAME=525252,,EPOPJ ;ERROR FRAME
$EVALFRAME=525252,,POP2J ;EVAL FRAME
;; $APPLYFRAME=525252,,AFPOPJ ;APPLY FRAME DEFINED BELOW
$UIFRAME=525252,,CPOPAJ ;USER INTERRUPT FRAME
;;; FORMAT OF EVALFRAME:
;;; <FLP>,,<FXP>
;;; <SP>,,<FORM>
;;; $EVALFRAME
L$EVALFRAME==3 ;LENGTH OF EVALFRAME
;;; FORMAT OF APPLYFRAME:
;;; -- ARGS --
;;; <FLP>,,<FXP>
;;; <SP>,,<FUNCTION>
;;; $APPLYFRAME
.SEE L$EVALFRAME
;;; WHERE -- ARGS -- MAY BE ONE OF THREE THINGS, DEPENDING
;;; ON ITS LEFT HALF:
;;; LH=0 RH=LIST OF ARGS
;;; LH<0 LH,,RH=AOBJN POINTER TO ARGS VECTOR (E.G. FOR LSUBR)
;;; LH>0 RH=LAST ARG; OTHER ARGS ARE BELOW THIS ON THE
;;; STACK. IN THIS CASE THE APPLYFRAME MAY BE MORE
;;; THAN FOUR WORDS LONG.
;;; EXAMPLE: MOVEI A,QFOO
;;; MOVEI B,QBAR
;;; CALL 2,QUUX
;;; CAUSES THIS APPLYFRAME TO APPEAR ON THE STACK:
;;; 0,,QFOO
;;; 2,,QBAR
;;; <FLP>,,<FXP>
;;; <SP>,,QUUX
;;; $APPLYFRAME
AFPOPJ: HLRE T,-2(P) ;APPLYFRAME POPJ
SKIPG T ;FIGURE OUT LENGTH OF
MOVEI T,1 ; APPLY FRAME
ADDI T,2
HRLI T,(T)
SUB P,T ;POP CRUFT FROM PDL
POPJ P, ;RETURN
$APPLYFRAME=525252,,AFPOPJ ;APPLY FRAME
SUBTTL NUMERIC TYPE-TESTING, CONVERSION, AND VALUE ROUTINES
IFN BIGNUM+DBFLAG+CXFLAG,[
FLTSK1: %WTA NMV5 ;UNACCEPTABLE NUMERIC VALUE
IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
] ;END OF IFN BIGNUM+DBFLAG+CXFLAG
FLTSK2: %WTA NMV3 ;NON-NUMERIC VALUE
IFE NARITH, JRST 2,@[FLTSKP] ;CLEAR PC FLAGS
FLTSKP: MOVEI TT,(A) ;"FLOAT SKIP" ROUTINE
LSH TT,-SEGLOG ; SKIPS 0 FOR FIXNUMS, 1 FOR FLONUMS (OR DOUBLES)
HRRZ TT,ST(TT) ;LEAVES NUMERIC VALUE IN TT
IFE NARITH, 2DIF JRST @(TT),FLTSTB,QLIST
IFN NARITH, 2DIF [JRST 2,@(TT)]FLTSTB,QLIST ;DISPATCH AND CLEAR PC FLAGS
FLTSTB: FLTSK2 ;LIST ;ERROR
FLTSFX ;FIXNUM ;SKIPS 0
FLTSFL ;FLONUM ;SKIPS 1
DB$ FLTSFL ;DOUBLE ;SKIPS 1
CX$ FLTSK1 ;COMPLEX;ERROR
DX$ FLTSK1 ;DUPLEX ;ERROR
BG$ FLTSK1 ;BIGNUM ;ERROR
FLTSK2 ;SYMBOL ;ERROR
HN$ REPEAT HNKLOG+1, FLTSK2 ;HUNKS ;ERROR
FLTSK2 ;RANDOM ;ERROR
FLTSK2 ;ARRAY ;ERROR
IFN .-FLTSTB-NTYPES, WARN [WRONG LENGTH TABLE]
IFN BIGNUM*<1-NARITH>, NVSKBG:
IFN BIGNUM*NARITH, NMSKBG:
FLTSFX: MOVE TT,(A)
JRST (T)
IFN BIGNUM*<1-NARITH>, NVSKFX:
FLTSFL: MOVE TT,(A)
JRST 1(T)
IFN BIGNUM*<1-NARITH>,[
NVSKP2: %WTA NMV3 ;NON-NUMEBIC VALUE
NVSKIP: MOVEI TT,(A) ;"NUMERIC VALUE SKIP"
LSH TT,-SEGLOG ;SKIPS: 0 = BIGNUM, 1 =FIXNUM, 2 = FLONUM, EHSE ERROR
HRRZ TT,ST(TT) ;LEAVES NUMERIC VALUE IN TT
α 2DIF JRST @(TT)(NVSKTB,QLIST .SEE STDISP
NVSKTB: NVSKP2 ;LIST ;ERROR
NVSKFX ;FIXNUM ;SKIPS 1
NVS@↔
0∩∩w
1∨⊂~VhInN.MαM↓HhR∩ ⊂LrZN∞β⊂$%n$zV
2(h*∞a J:ZN]↓H$%\~>6Bd*`4
%A⊂&:5~.AHHIn∩V∧b⊗`4T∩≥⊂&u2N.
8H%n
L::V4KZN.&¬→↓A1∧b⊗εZ-→α
&<rV5αD*ε∩⊗∩α&)α% 4(&u2N.A⊂H%nNLj
>0KZ⊗JJ⎇⊂4*"r!↓αJ-α⊗εQ∧B:.∩|9-E1∧rZN.β⊂%n",r.L%\*JJ>⊂h(&:5~.AHHInJεt">4%\*JJ>⊂h(&:5~.AHHInεJ∀
d%n-∩J>HhR&~9αq6:Z≤ZR 6u"fB⊗~aα↑ε∀qαn↑∀z:≥αd*:∞RBαRε
d*t4(hR:ZN\21h&lzZ∃α%!1"¬Hh(&*∃~Q↓IE!$4*hH%n⊗t!α>→∧J~9α∀J≡:VjQqE6t
J&RCp4(4Ph(4(hP04
L29α:
∩&R!eX4(4SYmmαu*6⊗JL→αN.M↓αJ>-"&:∀hQmmlHJ*NA¬!2:6≤Z&@4SYml&∀9⊂%↓rq8$%\B⊗J∃∧2>Iα∀J≡:Vm→mα∩,
Z⊗M∧B⊗ε∩-⊃α&9¬"P4)[Yl&∩B %↓9rp$%nD*J∃α4zIα∩-α2⊗`hQmmlL~a⊂%αq98$KZ"⊗J*α~>I∧~>6Bd*`4)[Yl&∩∩ %↓9rp$%nD*J∃α4zIα∩⎇*
2∃Zα2⊗ε4*Mα~M∩NQα<zJ⊃αLqαRPhQmmlHI↓99pH%n"-∩∃α~⎇⊃α~2|rV5m∧b⊗εZ-→αZεe*∃αεpαRP4SYel$Jq98$KZ"⊗J*α~>I∧2&b:,imα∩,
Z⊗M¬2ε2V*α&)α% 4)m[Yαε2≤yα∞2,
JMα$B∃αB~α~2ε=_4(4Tr6N.β⊃h%⊗="¬α:m1L$%\r>96u*6⊗JL→αZεe*∀4*tjN.&βP&6>4*%αR"a"¬$hP&2NBαRQ1m~⊗≡2|84(&E∩Jiα%!2NQE"Q$4R↓↓↓J$J→αnU∩NQ↓∩b↓"R"Jv:6≤ZR 2 b&NPhP4)n∧→α~2 :Mα&rαR"&~αRε
d)α6V≥!α
∃¬R⊗J<hR:6N]" h&tjN.A⊂H$%ndJNP4PJ:6N\2`$$KZ~&bu*44(Lr6N.4`$$%\22>:,h4*∩∩ &:6≤Z∩λ$HIn∩>,∩2∀4T~a⊂&tjN.∞ ;COMPLEX
DX$ NMSKDX ;DUPLEX
BG$ NMSKBG ;BIGNUM
NVSKP2 ;SYMBOL
HN$ REPEAT HNKLOG+1, NVSKP2 ;HUNKS
NVSKP2 ;RANDOM
NVSKP2 ;ARRAY
IFN .-NVSKTB-NTYPES, WARN [WRONG LENGTH TABLE]
NMSKFX: MOVE TT,(A)
JRST BIGNUM+DXFLAG+CXFLAG+DBFLAG+1(T)
NMSKFL: MOVE TT,(A)
JRST BIGNUM+DXFLAG+CXFLAG+DBFLAG(T)
DB$ NMSKDB: MOVE TT,(A)
DB$ JRST BIGNUM+DXFLAG+CXFLAG(T)
CX$ NMSKCX: JRST BIGNUM+DXFLAG(T)
DX$ NMSKDB: JRST BIGNUM(T)
] ;END OF IFN NARITH
LR70==:20 ;LAP AND FASLAP HAVE THIS QUANTITY BUILT IN
D10.0: 10.0
0
D1.0E8: 1.0↑8
0
CDUPL1: DUPL1 ;FOR (% 0 0 DUPL1)
CCMPL1: CMPL1 ;FOR (% 0 0 CMPL1)
CDBL1: DBL1 ;FOR (% 0 0 DBL1)
CFIX1: FIX1 ;FOR (% 0 0 FIX1)
CFLOAT1: FLOAT1 ;FOR (% 0 0 FLOAT1)
R70: REPEAT LR70, .RPCNT,,.RPCNT ;COMMON LAP CONSTANTS ALSO USED BY LISP CODE
ZZZ==5
IFL ZZZ-NACS, ZZZ==NACS ;NEED AT LEAST <NACS> OF THESE
REPEAT ZZZ, .RPCNT-ZZZ
XC:: ;WRITE "XC-N" TO GET THE CONSTANT -N FOR SMALL N
;;; INTERNAL FLONUM-TO-FIXNUM CONVERSION; DOES NO ERROR CHECKS.
;;; CONVERTS NUMBER IN TT TO BE A FIXNUM, CLOBBERING D.
;;; THE CONVERSION IS A "FLOOR" OR "ENTIER" FUNCTION.
;;; THAT IS, 3.5 => 3, BUT -3.5 => -4.
IFIX: MULI TT,400 ;EXPONENT IN TT, MANTISSA IN D
TSC TT,TT ;THIS HACK GETS MAGNITUDE OF EXPONENT
ASH D,-243(TT) ;SHIFT THE MANTISSA
MOVE TT,D ;RESULT IN TT
JRST (T)
;;; INTERNAL FIXNUM-TO-FLONUM CONVERSION. SAVES D.
IFLOAT: TLNE TT,777000 ;FOR POSITIVE INTEGERS 27. BITS OR LESS,
JRST IFLT1 ; CAN JUST USE FSC TO SCALE
IFLT5: FSC TT,233 ;FSC NORMALIZES RESULT
JRST (T)
IFLT1: TLC TT,777000 ;THE SAME HACK WORKS FOR NEGATIVE NUMBERS
TLCN TT,777000 ; WITH NO MORE THAN 27. SIGNIFICANT BITS
JRST IFLT5
IFLT2: MOVEM D,IFLT9 ;FOR 28. TO 35. BITS OF SIGNIFICANCE,
JUMPL TT,IFLT3 ; WE CONVERT THE LEFT AND RIGHT HALVES
HLRZ D,TT ; SEPARATELY, AND THEN ADD THEM, TRUNCATING
MOVEI TT,(TT)
IFLT4: FSC D,255 ;SCALE RIGHT HALF
FSC TT,233 ;SCALE LEFT HALF
FAD TT,D ;ADD TOGETHER
MOVE D,IFLT9 ;RESTORE D
JRST (T)
IFLT3: HLRO D,TT ;FOR NEGATIVE NUMBERS, WE MUST
HRROI TT,(TT) ; PRODUCE THE CORRECT SIGN
AOJA D,IFLT4
;;; NUMERIC VALUE ROUTINES. THESE CHECK AN S-EXPRESSION
;;; FOR BEING THE DESIRED NUMERIC TYPE, AND PRODUCE A
;;; WRNG-TYPE-ARG ERROR IF APPROPRIATE. OTHERWISE
;;; THE VALUE OF THE NUMBER IS LIFTED INTO TT (D,R,F).
COMMENT |FXNV1: FXNV2: FXNV3: FXNV4:|
;;; FXNV1 (2,3,4) TAKES S-EXP IN A (B,C,AR1) AND PUTS VALUE IN TT (D,R,F).
IRPC AC,,[1234]
EFXNV!AC:
IFN AC-A, EXCH A,AC
%WTA FXNMER
IFN AC-A, EXCH A,AC
FXNV!AC: MOVEI TT-1+AC,(AC) ;CHECK DATA TYPE
ROT TT-1+AC,-SEGLOG
SKIPL TT-1+AC,ST(TT-1+AC)
TLNN TT-1+AC,FX ;SKIP IFF FIXNUM
JRST EFXNV!AC ;LOSE
MOVE TT-1+AC,(AC) ;GET VALUE IN NUMERIC AC
JRST (T)
TERMIN
FLNV1X: AOJA T,FLNV1 ;FLNV1 WITH SKIP RETURN
EFLNV1: %WTA FLNMER
FLNV1: SKOTT A,FL ;GET FLONUM VALUE IN TT FROM A
JRST EFLNV1¬
MOVE TT,(A)
JRST (T)
IFN DBFLAG,[
EDBNV1: %WTA DBNMER
DBNV1: SKOTT A,DB ;GET DOUBLE VALUE IN (TT,D) FROM A
JRST EDBNV1 ;HIGH ORDER WORD IN TT, LOW ORDER IN D
KA MOVE TT,(A)
KA MOVE D,1(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN DBFLAG
IFN CXFLAG,[
CXNV1X: AOJA T,CXNV1 ;CXNV1 WITH SKIP RETURN
ECXNV1: %WTA CXNMER
CXNV1: SKOTT A,CX ;GET COMPLEX VALUE IN (TT,D) FROM A
JRST ECXNV1 ;REAL PART IN TT, IMAGINARY IN D
KA MOVE TT,(A)
KA MOVE D,1(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN CXFLAG
IFN DXFLAG,[
EDXNV1: %WTA DXNMER
DXNV1: SKOTT A,DX ;GET DUPLEX VALUE IN (R,F,TT,D) FROM A
JRST EFLNV1 ;REAL PART IN (R,F), IMAGINARY IN (TT,D)
KA REPEAT 4, MOVE TT+<2#.RPCNT>,.RPCNT(A)
KIKL DMOVE R,2(A)
KIKL DMOVE TT,(A)
JRST (T)
] ;END OF IFN DXFLAG
BAKPRO
RSXST: HRRZ TT,VREADTABLE ;READ CHARACTER SYNTAX
HRRZ TT,TTSAR(TT) ; TABLE SETUP
HRLI TT,((A)) ;USED AS INDIRECT ADDRESS WITH
MOVEM TT,RSXTB ;INDEX FIELD A
NOPRO
JRST (T)
SUBTTL SUPPORT FOR LAP/FASLAP CODE
;;; USE THE PUSHN MACRO TO PUSH N NIL'S (0'S, 0.0'S) ONTO P (FXP, FLP).
;;; IT WILL GENERATE JSP T,NPUSH-N (0PUSH, 0.0PUSH) AS APPROPRIATE.
;;; COMPILED CODE USES THESE ROUTINES VERY FREQUENTLY.
REPEAT NNPUSH, CONC \NNPUSH-.RPCNT,NPUSH,: PUSH P,R70
NPUSH: JRST (T)
REPEAT N0PUSH, CONC \N0PUSH-.RPCNT,PUSH,: PUSH FXP,R70
0PUSH: JRST (T)
REPAAT L0.0PUSH, CONC \N0.0PUSH-.RPCNT,.PUSH,: PUSH FLP,R70
0.0PUSH: JRST (T)
40PESH: PUSH FLP,T
REPEAT 40/N0PUSH, JSP T,0PUSH-N0PESH
ZZZ==40-N0PUSH*<40/N0PUSH>
IFN ZZZ, JSP T,0PUSH-ZZZ
POPJ FLP,
CINTREL: INTREL ;RANDOM USEFUL RETURN ADDRESS
INTREL: POP FXP,INHABIT .SEE UNLMCKI 9CGME HERE TO PERFORM AN UNLOCKI
CH@ π↔$p∪'↔%!≤A≥=##∪($∩wπ⊃∃β⊗A
=$A 1β3 λ↓∪≥)%I+!)&4∀∩A'-∪!≤A%≥)
→≤~∀%ααB>BRαA0$KZ⊗b&"α&→αtz2∀4PJ*JN"α∞.%H%n⊗e~∃α≡zαBJ>≤*NL4RrN⊗∃∧J:RbM 4(4Ph(&*∃~Qα∞$~ε20HIf∞ε$~"ε2bα& 2λ9tm∧→HT"∧9xD(h!→%∃≥Dλ4
$(~ HK88∃$≤¬X$
∃)_U∩∧→`λλ→s4∩)H1λ⊂ix⊃#"A→TTu∧λp5∀
Zb".h9s4∩)H1λ⊂ix⊃(⊂h→⊃∀hλ_5⊂r↓QQ0ThZ∃4∞AQ@4∃*9λ∀ λ!.psiZ⊂3⊃(D⊂sqλT⊂p3 Jh⊃4J*q5β!!2Tt∧
⊃4J:∀β"A→3uQ)T∀ ⊃**U∪C!!4q5 )(⊃4J*uc"A~rr4λT⊂""!↔uP3
X(∩3Dλ(⊃⊃*8tR0HZh⊃rλZ⊂⊃4Dλ4TSj*h∀∀I→β*εEαP)bj∪d¬ ERRSW
JRST (TT)
λ
¬'U¬))_%'+!!=%(A
=$Aπ∨5!∪→ ⊂A→' %&~∀4∀vvv↓≠% ∪9β%2AQ3!
A
∨⊂⊗BLb⊗⊃αe~V
J~α
ε≡LqαR",JIα∞|"∃α↑M" $)[Y`_L*:α∧"EiD IAPS[74∧u,XZ$L~
K∃∧
λ9tm∧→HT"∧J:T¬∃4λ$,<→`¬$DY~"∧≤xHR¬<~IhS570LU:∧∧"biH4 dEY`HK9`∧M~λ⊂∧5,h:DL\d t2¬IλR¬%~λPhS570J∧*:α∧"EiD IAPS[74¬$D~4¬∀⎇ZI∀d
λ¬⊂)84h⊂h~Q(∪hd⊂R3HI3Q`λ~Qs∪h4⊂3Q∧λ4QsJY(⊃Sj$∃∩⊃!QLnndλQ3Q(i5λ∪hd∃∩⊃$λ4Qk∧
q1⊂*(kλ⊂)hλ∪∩*:∩1V$λU3PjI3sTeA"NngP g"λ* ebH!`i"H'c⊂#∪*id$S!P*$⊃P i#Udbg*∀P#)'SP*$"H)j aRWεEεB≥]]P∃$"P'T""i⊂∪c⊂*$⊃ibP"S*),P∀'dg*∀P$iP⊂*df*λ$g*'H*$"P⊂gfh$S"iεEαe))jλ↔&!`Q,∧]iQh*h⊂⊃'i⊂"∃h&"lλ*,h"H!gfh∩f"b∪)ja)∀FE∧e∀)j⊂↔∪!`alα]ibj∃h⊂#'T⊂!gfT&"l⊂∃,h"P⊂gfh$S"b⊂&∀ja))CEe)∀j⊂↔&⊂`b!∧Nibj*TLE TYPE COMPILED LSUBRS
JRST .LCAFL ;SETUP FOR FLONUM TYPE COMPILED LSUBRS
JRST .LCAFX ;SETUP FOR FIXNUM TYPE COMPILED LSUBRS
.LCALL: PUSH P,R70 ;SETUP FOR REGULAR COMPILED LSUBRS, OR NCALL ENTRY
.LCAF5: MOVN TT,T ;NUMBER OF ARGS
ADDI T,-1(P) ;ADDR OF BEGINNING OF ARG VECTOR
CAIL TT,XHINUM ;XHINUM IS TYPICALLY >777, SO THERE'S LITTLE
JRST LXPRLZ ; CHANCE OF THIS SCREW, BUT BETTER BE SAFE
MOVEI A,IN0(TT)
MOVEI TT,(T)
JSP T,SPECBIND
0 TT,ARGLOC ;ARGLOC HOLDS PDL POSITION FOR VECTOR OF LSUBR ARGS
0 A,ARGNUM ;ARGNUM IS NUMBER OF ARGS, AS A LISP FIXNUM
PUSHJ P,(D) ;CALL THE USER FUNCTION, NUMBER OF ARGS IN A
POP P,D
SKIPN T,@ARGNUM
JRST .LCAF7 ;MIGHT AS WELL BUM FOR NO ARGUMENTS
HRLS T ;GOT TO GET RID OF THE ARGUMENTS
SUB P,T
.LCAF7: JUMPE D,UNBIND ;THIS EXIT SIGNALS CALL TO NOTYPE LSUBR, OR NCALL TO NUMERIC
PUSH P,D ;ELSE EXIT THROUGH FIX1 OR EQUIVALENT,
JRST UNBIND ; MEANING REGULAR CALL TO NUMERIC LSUBR
.LCAFX: PUSH P,CFIX1 ;PUSH ADDRESS FOR CONVERTINGMACHINE NUMBER TO FIXNUM
AOJA D,.LCAF5 ;INCREMENT D PAST THE CALL TO .LCALL-0 WHICH FOLLOWS
.LCAFL: PUSH P,CFLOAT1
AOJA D,.LCAF5
.LCADB:
DB$ PUSH P,CDBL1
DB$ AOJA D,.LCAF5
DB% LERR [SIXBIT \CALL TO DOUBLE-TYPE USER LSUBR!\]
.LCACX:
CX$ PUSH P,CCMPL1
CX$ AOJA D,.LCAF5
CX% LERR [SIXBIT \CALL TO COMPLEX-TYPE USER LSUBR!\]
.LCADX:
DX$ PUSH P,CDUPL1
DX$ AOJA D,.LCAF5
DX% LERR [SIXBIT \CALL TO DUPLEX-TYPE USER LSUBR!\]
;;; THESE THREE FUNCTIONS MERELY SAVE THE LOSER THE TROUBLE OF TYPING "SETQ ".
NORET: PUSHJ P,NOTNOT ;SUBR 1
HRRZM A,VNORET
POPJ P,
.RSET: PUSHJ P,NOTNOT ;SUBR 1
MOVEM A,V.RSET
POPJ P,
NOUUO: PUSHJ P,NOTNOT ;SUBR 1
HRRZM A,VNOUUO
POPJ P,
SUBTTL VARIOUS LISTING AND DE-LISTING ROUTINES
LIST: PUSH FXP,CCPOPJ ;LSUBR
LISTX: MOVEI A,NIL ;BASICALLY, THE FUNCTION "LIST"
SKIPN R,T ; CALLED WITH A PUSHJ FXP,
LISTX3: JUMPE R,CPOPXJ
MOVEI B,(A) ;CLOBBERS A,B,T,TT,R
POP P,A
JSP T,PDLNMK
JSP T,%CONS
AOJA R,LISTX3
MAKLST: JSP T,FXNV1
TDZA A,A
PUSHJ P,NXCONS
SOJGE TT,.-1
POPJ P,
;;; INTERNAL LISTING FUNCTION; EVALUATES A LIST OF ARGS,
;;; STACKING THEIR VALUES ON THE PDL
KLIST: HLRZ B,(A) ;SUPER-HACKISH VERSION
PUSH P,B
HRRZ A,(A)
JLIST: HLRZ B,(A) ;HACKISH VERSION WHICH DOESN'T
PUSH P,B ; EVAL FIRST ARG OR COUNT IT
HRRZ A,(A)
ILIST: MOVEI T,0 ;CALLED BY JSP TT,ILIST
JUMPE A,(TT)
PUSH FXP,TT
PUSH FXP,T ;CONTAINS 0 - USED AS COUNTER
PUSH FXP,R ;MUST SAVE R!
ILIST1: PUSH P,A ;OTHERWISE, THIS EVAL LOOP
HLRZ A,(A) ; MAY CLOBBER ANYTHING
PUSHJ P,EVAL
ILIST3: EXCH A,(P) ;SAVE VALUE ON STACK
HRRZ A,(A)
SOS -1(FXP) ;COUNT VALUES
JUMPN A,ILIST1
POP FXP,R ;RESTORE R
POP FXP,T ;T HAS -<# OF VALUES ON PDL>
POPJ FXP,
;;; JSP T,GTRDTB ;GETS READTABLE IN AR2A, AND MAYBE CHECKS FOR ERRORS.
GTRDTB: HRRZ AR2A,VREADTABLE
SKIPN V.RSET ;ERROR CHECKS IFF *RSET NON-NIL
JRST (T)
SKOTT AR2A,SA
JRST GTRDT8 ;ERROR IF NOT ARRAY
MOVE TT,ASAR(AR2A)
TLNE TT,AS<RDT> ;ERROR IF NOT READTABLE TYPE ARRAY
JRST (T)
GTRDT8: PUSH P,B
MOVEI A,QREADTABLE
MOVEI B,READTABLE ;ON ERROR, RESTORE TO STANDARD READTABLE
PUSHJ P,BDGLBV ;GIVE OUT A FAIL-ACT
POP P,B
JRST GTRDTB ;TRY AGAIN IF LOSER RETURNS TO US
SUBTTL NOINTERRUPT FUNCTION
NOINTERRUPT: JUMPE A,CHECKU ;SUBR 1 - ENABLE/DISABLE
CAIN A,QTTY
JRST CHECKU
SETO A, ; RANDOM ASYNCHRONOUS
NOINT0: EXCH A,UNREAL ; "REAL TIME" INTERRUPTS
SKIPGE A ; (CLOCKS AND TTY)
MOVEI A,TRUTH
POPJ P,
;;; CHECK FOR ANY DELAYED "REAL TIME" INTERRUPTS, AND RUN THEM
;;; IF ANY. MUST DO THEM IN THE ORDER ↑G/↑X, CLOCKS, AND OTHER.
;;; NOTE THAT AFTER A ↑G OR ↑X, CHECKU GETS CALLED AGAIN.
;;; DESTROYS D AND F
CHECKU: SKIPN UNREAL ;NONE CAN BE PENDING IF NOT DELAYING
JRST NOINT0
CHECKQ: PUSH P,A
PUSHJ P,UINTPU
NOINT1: SKIPE (P)
JRST NOINT5
SKIPE D,UNRC.G ;PROCESS ↑G/↑X FIRST
JRST CKI2A ;TOP LEVEL OR ERRRTN WILL DO A CHECKU
NOINT5: PUSHJ P,NOINTA ;NOW PROCESS ALARMCLOCK INTERRUPTS
JRST NOINT1
NOINT3: SKIPG F,UNREAR ;NOW ANY OTHER INTERRUPTS
JRST NOINT4
SOS UNREAR
MOVE D,UNREAR(F)
TRNE D,400000 ;IF (NOINTERRUPT 'TTY), SUPPRESS
↓ SKIPN (P) ; TTY IJTERRUPTS AT THIS TIIE
PUSHJ P,YESINT ;MAY CLOBBER R (SEE UISTAK)
JRST NOINT1
NOINT4: SKIPG A,UNREAL
MOVEI A,TRUTH
POP P,UNREAL
JRST UINTEX
;;; DO FOT TRANSFORM THE "PUSHJ, POPJ" SEQUENCES INTO "JRST".
;;9 YESINT DEPENDS ONLOOKINC AT THE PUSHJ ADDRESS TM SEE WHETHAR
;;; WE CAME FROM NOINTERRUPT OR ELSEW@⊃ I
B
∀4∃≥∨∪9)αt∪M↔∪!≤↓λY+≥I%+≤~(∩A∃%M(A≥∨%≥(d~(∪' )i~A+≥I%+≤~(∪!+'!∀A Ye '∪≥P~∀∪!=!∀A 0~∃≥∨%≥(dt%'↔∪!8AλY+9%)∪~4∀∩A∃I'(A!=!∀b~(∪' )i~A+≥I)∪~~(∪!+'!∀A Ye '∪≥P~∀∪!=!∀A 0~∀
∃∃≥∨∪≥Ppt\∩$∩]' ∀A+∪≥Pa≤~∀_~∀∩4∀∩~∃M+¬))0∪πβ$=π $AI∨#)∪9 &Aβ9λA
+9π)∪∨9&~∀~(vvvA! %
A →∂.↓
∨→→=.A)⊃∀@E
βM(DAπ¬$[π HA%∨+Q∪∃ &0@~∀vlvA+'∃λA/⊃∃≤@U%M ({≥%_XAβ9λA¬2↓π∨≠!%→ λA
∨
\4∀vvv↓≥∨)
↓)⊃β(↓)⊃
AI →β)%-
A %'!→β
≠ ≥PA∨ AQ⊃
A
U≥π)∪=≤A ≥Q%2A!=∪∃)&4∀vvv↓∪&A-∃%%%%I2A∪≠A∨%)β9(A)≡↓)⊃
AA∨∨∨$↓π∨≠!1$\@~(vvvA⊃∨≥(A∃- $A
⊃β≥∂∀A)⊃ 4BB~∀4∃πβ%
$t∩$∩∩w∪9 A9+≠¬ HA
∨$↓πβ→_↓¬2Aπ=≠!∪→∃λAπ∨⊃
~∀K
β Ht∪'↔%!αAα0QαR∩l@`~∀∃πβ ¬$t∪⊃1%4Aα0QαR∩l@b~∀∃πβ Ht∪'↔%!αAα0QαR∩$v@d~(Kπβ ¬$t∪⊃1%4Aα0QαR∩$v@f~(Kπβ Ht∪'↔%!αAα0QαR∩$v@h~(KπββHt∪⊃→I4AαX!αR∩∩l@j~∀∃πβ$t%⊃→%4↓αXQα$∩∩v@X~∀∪∃I'(@QPR~∀K
Ht∪'↔%!αAα0QαR∩l@p~∀∃π ¬$t∪⊃1%4Aα0QαR∩l@r~∀∃π Ht∪'↔%!αAα0QαR∩$rb`\
%CDDAR: HLRZ A,(A) ;11.
%CDDR: SKIPA A,(A) ;12.
%CDAR: HLRZ A,(A) ;13.
%CDR: HRRZ A,(A) ;14.
JRST (T)
%CAADDR: SKIPA A,(A) ;16.
%CAADAR: HLRZ A,(A) ;17.
%CAADR: SKIPA A,(A) ;18.
%CAAAR: HLRZ A,(A) ;19.
JRST %CAAR
%CDADDR: SKIPA A,(A) ;21.
%CDADAR: HLRZ A,(A) ;22.
%CDADR: SKIPA A,(A) ;23.
%CDAAR: HLRZ A,(A) ;24.
JRST %CDAR
%CAAADR: SKIPA A,(A) ;26.
%CAAAAR: HLRZ A,(A) ;27.
JRST %CAAAR
%CDDADR: SKIPA A,(A) ;29.
%CDDAAR: HLRZ A,(A) ;30.
JRST %CDDAR
%CDAADR: SKIPA A,(A) ;32.
%CDAAAR: HLRZ A,(A) ;33.
JRST %CDAAR
%CADADR: SKIPA A,(A) ;35.
%CADAAR: HLRZ A,(A) ;36.
JRST %CADAR
;;; THE FOLLOWING TABLE IS A TRANSFER VECTOR: GIVEN THE INFO-NUMBER
;;; OF A CAR-CDR OPERATION, SAY N, THEN CARCDR[N-2] IS THE
;;; ADDRESS OF THE FAST ROUTINE FOR THAT OPERATION. NOTE THAT THE
;;; INFO-NUMBER IS NOT THE SAME AS THE INDEX-NUMBER-FOR-COMPILED-CODE
;;; ALSO, THE TOP 13. BITS ENCODE A DECOMPOSITON OF THE A-D STRING INTO
;;; 1) THE LEFT-MOST OPERATION - 1 BIT (1 FOR "D" AND 0 FOR "A"),
;;; 2) THE INFO NUMBER OF THE "TAIL" - 6 BITS ("TAIL" IS REMAINDER OF
;;; A-D STRING, E.G., "TAIL" OF "ADDAD" IS "DDAD")
;;; 3) THE "BOY ARE THESE NUMBERS RANDOM" NUMBER WHICH THE COMPILER
;;; USES WHEN OUTPUTTING FAST JSP CALLS THE THE %CARCDR ROUTINES.
%CARCDR:
IRP X,,[A,D
AA,AD,DA,DD
AAA,AAD,ADA,ADD,DAA,DAD,DDA,DDD
AAAA,AAAD,AADA,AADD,ADAA,ADAD,ADDA,ADDD
DAAA,DAAD,DADA,DADD,DDAA,DDAD,DDDA,DDDD]AD,,[0,1
0,0,1,1
0,0,0,0,1,1,1,1
0,0,0,0,0,0,0,0
1,1,1,1,1,1,1,1]TL,,[0,0
2,3,2,3
4,5,6,7,4,5,6,7
10,11,12,13,14,15,16,17
10,11,12,13,14,15,16,17]
zz==%C!X!R
AD←35.+TL←29.+<zz-carcdr>←23.+zz
TERMIN
ICADRP: PUSH P,CFIX1 ;+INTERNAL-CARCDRP
JSP T,IC.RP
SETO TT,
POPJ P,
;;; SKIPE IF CARCDR FUNCTION, WITH CODE WORD IN TT
IC.RP: CAIL A,QCAR ;First
CAILE A,QCDDDDR ;Last CARCDR sym
JRST (T)
2DIF [HLRZ TT,(A)]%CARCDR,QCAR
LSH TT,-5
JRST 1(T)
;;; STANDARD INTERPRETER SUBRS FOR THE VARIOUS CAR-CDR
;;; OPERATIONS. THESE CALL A AENTRAL DECODER WHICH IN*RSET
;;; MODE PERFORMS TYPE CHECKING ON THE OPERAND AT EACH STEP.
CRSUBRS:
IRP X,,[A,D,AA,AD,DA,DD
αAAA,AAD,ADA ADD,DAA,DAD,DDA,DDD
AAAA,AAAD,AADA,AADD,ADAA,ADAD,ADDA,ADDD
DAAA,DAAD,DADA,DADD,DDAA,DDAD,DDDA,DDDD]
C!X!R: JSP F,CR0
TERMIN
;;; LET A=0, D91, AND LET CWXYZR BE A AAR-CDR OPERATIMN, WIT@
;;; THA FARIABLES W,X,Y,Z RANGING OVAR {,A,D}. LET A NUMBERN
;;; BE COMPUTED CORRESPONDINC TO CXYZWR AS FOLLOSS:
;;9 F = Z + 2 IF W,X,Y ARE NULL
;;; N = Y*2 + X + 4 IF W X ARE NULL
;;; N = X*4 + Y*2 + Z + 1⊂ IF W IS NULL
;;9 N = W*10 + X
4 + Y*2 + X + 20 IF NON@
A∨_A.Y012Y4A¬%
A≥U→_~∀lrvA≥=)
A ]~A)⊃%≥π&T4∀vvv↓6c:AQ⊃∪&AI !% M ≥)βQ∪∨≤A= AαA
β$[π⊃$A∨!∃%β)∪=≤A∪&↓ β'∪12~∀vlrA¬∪Q+∪'
↓ βπ∨⊃β¬→
8A)⊃
↓!∨'∪Q∪∨≤A= A)⊃∀A
∪%M(@bA ∪(~∀lrvA∪9 ∪πβQ &A)!
A')¬%(A∨_A)⊃
↓% '(↓∨ A !
A ≥
≠ ∪≥≤XA/⊃%β⊂A⊃¬&~∀vlr@`A→∨$Aπ¬$X@b↓
∨$A
$AβPA βπ A!∨'%)∪∨≤8~∀fvlA6e:↓
∨$A¬≥2A'∃(A∂ ↓∨! %¬)∪∨≥LAπ∨≠A→ )
↓
%∨~↓ββ$A¬≥λAπ⊃$X~∀lvvA)!%∨+∂ AπββHXAπβ⊃$X@\8\A)≡E→ -∃_A~D↓ββ$[
$O&Q)⊃∨M
A/∪Q⊂∩∀vlrA
A∧O&Aβ9λAλOLRXA)!∪&A 9π∨ ∪9∞A!¬= +π LAαAπ=≠!βπPA ≥π= ∪≥∞0~∀vvl∩∩∩@@@@A4Vb~∀lvvA/%)⊂A≤↓%β≥∂%≥εA
I∨⊂∃↓⊂αR=↓∩↓↓↓5
α&*∞e*N&Z*p4)M[X4)M[Y↓α: j∀%αr↓">∞$
1$&r↓"
&t
Je$hQmmmα↓α∞ε⊂I↓↓↓⊂H%↓↓β @$)[Ym↓↓∧~∩H%α↓↓L$J↓↓↓Eλh)mmZ↓↓α∞
H%↓α↓P$%α↓EA@hQmmmα↓α∞ε%⊂%↓↓β($%↓β AD4SYmm↓α↓9↓9αp4)m[Y↓↓α≤"∩ε∩⊂I↓↓M(H%EE ↓D4)[Ym↓↓∧~∩∩∩
⊂%↓↓≠0$%E E@4SYmm↓αα∞∩∩$"H%↓β→\$% EEDhP4(4P04(hR∞IAPJN.&∧)αY:∃~⊗P4PIα*J≥!α∞Iλh(&B⎇↓αA2 h(&*∃~Qα↓,~εJ∞%⊃5r∞∃~V
J~YEy"2H%nF,J∞-α4*JN&|qα~>∩↓*JN-!↓uαtJ04(hR∞IEPJBVNDQαA2≤
ZaLHIn∞>mα&2⊗"α∞>∩*αεNN,j⊗Mαu*6ε∞~αNε~(h*∞I h&6⎇2⊗%α"a"¬$hQ↓↓↓∀"&→α\j>Z⊗JαQ1"2JuAAβ↓AI2≥∩NV
∃→-D%[!AAAβ↓α&M∧2>Iα≤ :∩⊗⊂h*∞I∪P&N.⎇"Qα⊃dbL$%\~"⊗∞Zα~>I∧b&NQ¬"fB∀hP%α*∃~Qα∞∪ 4*∞∪→h&R∀r9αQcλ$%n≤Z&AαL1α∞∩∩α>B⊗∀
R&>ph(%αU∩NQα≥⊃Nλ4PJ"JJRα⊃1""H4*∞∪~¬h&∀zQαQbiD4(M"J:∃¬!1]]0H%nN\JAα&2αε21∧">:∀hP%α*∃~Qα∞∪⊂4*∞⊃9h&6⎇2⊗%α
a"⊃$hP&*J≥!αJN%AL$%\~>6BLb⊗⊃α≤z∩¬α
~NV6-→α:Vl
∞Mα≤
~∀4Ph*∞I≤⊃h&Rdr∃αR"b":,HIn&→∧JRMα
α"V:ZaαR",qα∞ε∩α"ε⊃∧∩⊗RR-⊂4(¬∧RJNQ∧~IN hP&"2∃Qα⊃1D!$$%]"ε.∃¬""¬α≤
H4(LRJNQ∧~IN∧hR∞IN≠P&"2∃QαRQbB⊃$∀PJεε&rα⊃15λH%n:⎇!α
∃∧ αV:-~⊗⊃α≤b>P4PIα*J≥!↓9-_h(%↓∧j>Z∃∧!2RPhP%↓αU∩NQα≥⊃N∧4PJ6>Z,Iα¬1D!$4(MαVN"RαA2↑dB⊗JHhP&6>4*%α⊃bB¬$4PJ*JN"α∞IHhP4*∞⊃!h&R∀r∃αQcλ$%nL1α:⊗E!αεJ:α&N9=!α¬αdJNP4PIαN.Mα¬αIe2∞∩HHInR",qα∞",~-α>-!αε≡ J:NQ¬α⊗J6M~N&
dJR&⊗_h(%↓∧j>Z∃¬⊃2Z∞
⊂4(&U*6B9¬⊃2∞I(h(&R∀r9α⊃biD$%\J→α>tbeα:Laαε:"α2&N%→αB⊗∀j&NNL∩2∀4PIα*J≥!α∞I8H%nRD*9α2-!α:&bα
⊗∞|j∃α~La↓"∞
⊃α:&bI↓u↓D~∩IαtJ1%↓hα:&0hP&*J≥!α∞¬t"⊗H$KZ⊗"N*aα
>l⊃α>V h(4*≥⊃Uh&≤
&∃α∩bFNfl∩>04PIα*J≥!α∞I0h(&R∀r∃α⊃biD4(JαR2:*αRQ2≥H4(¬αα*JN"α∞ILhP&*J≥!α∞¬t"⊗H$KZ2>N*α&→αt*&R"-⊃α:&bα:>I¬~f6
|`4(4T~IYhL~ε&9¬⊃2F2M~P4(Jα*JN"α∞¬:$*H$%\b&NQ¬"⊗NQ∧z9αε∀9α"ε~αε2J,
∩eα4
&2⊗"aαN=∧2ε&0hP&*J≥!α∞I_H%n&2α∞εId~∩IαtzQ↓
dJNQ b↓
Nfl∩>1 bα>I↓∀r&1 `h($$HImαRD*9α>Zα~>I∧
:fRDJ:≤4P
α
;;; NTH and NTHCDR - if *RSET is off, try to do fastly
; (N@) A≤A
=≡RA%∃)+%≥LA)⊃
↓≥)⊂A
β$A7]⊃ %
Q≥)⊂`A
∨<RA∪&Qπβ$↓
∨≡St~∀v@$@@@@A #+%-β→ 9(A)≡Qπβ$Q≥)⊃
$A≤↓
∨≡R$~∀f@!≥)⊃π⊃$A≤A→∨≡RAI !+¬9&A)⊃∀A% πU→(A∨_@O N↓π $OL~∀
∀4∃≥)⊂h∪) 5∧A$Y$4∃≥)⊃
$d∪5∨- ∩↓$Y)%U)⊂∩∩m$A∪&E≥)⊃
$E ↓
→β∞Z@PRzz|@ ≥)⊂D4∃≥)⊃
λjt∪M↔∪!≤↓λY,]I' (~(∩A∃%M(A≥)!πλl~(∩@A'-∨)(A∧Y
0~(∩@@A)%'(A9)⊃β 8~∃≥ !πλlT%≠↔-
↓)(XQ∧R~∀∪)+∪!→∀A)(Y9)⊃πλ@∩w≠-~Qα
*α:>9lr⊗≡ε$JR∧4PJ⊗b∞@α¬2λHI`≥∀X:Te"
Ir∧∀T
$-∃0 '⊃b⊂$gλ BE∧R*fh'λ"∩'*∩!b→∧B]U))Qj⊂≡NO⊂"'P⊃i)'iλ!d"aRP#g⊃`ad⊂⊃d"fbSαT
NTHCD18∧∪⊃%I0AαX!αR∩∩m ≡Aα↓π $~(∪'∂∃≤A)(Y9)⊃πλD∩∩g→=∨ A+9)∪_A¬!!%∨A%∪β)∀A≥+≠ $A∨_Aπ $≥&A ∨9
~∀∪)+≠!
↓$XIπ¬$∩∀∪A∨!)¬↓0$$KZR"⊗rαJ⊗R-∩8 (!Q$u$λ8CβP→*Tm∧d
E"djI∧L,a⊃∪LLhHUBα&∧ hPα16λ9λ⊂#λεA∧e∃dh'∀⊗!h'T%D]R*ij⊃l j⊂⊃'i⊂'∃$!b)βE JUMPE D,$CAR 3BEAKME "CAR" FOR (NTH0 X)
JRST CAR
¬
NTHCD2: MORE F,(B)
SOS F
PUSHJ P$LASTCK ;TAKE "(F)" CDRS$ SKIP IF SUCCESSFUL
JRST NTHER ; ERROR IF ARG-1 CDRS IS ATMIIC
JUMPN B NTHCD4
HRRZ D,(D)
SKOTT D,LS
JUMPN D,NTHER
HLRZ A,(D)↓ ;FOR "NTH"
POPJ P,
NTHCD4: HRRZ A,(D) ;FMR "NTHCDR", TAKE FINAL CDR
POPJ P,
SUBTTL SYMBOL CONSER
PNGNK: ADD@∩A Y!
¬U Zb∩$w∨≥→dA¬"A%≥) %8@ZA!U%∪
∪∃&A!≥¬≠
A∪_A% →∃-β≥(4∀∪'↔%!∂
A1!≥ ∩$w∪ A1!≥ A%&A≥ ≥β)∪-∀XA)⊃∀A!≥β5
A∪&↓∪≤A!9¬+ X4∀∩A!U'⊃∧A@Y!≥π=≥&∩∩lA'≡A]
Aπ∨9&A∪(↓+ A≥=.~∀∪M↔∪!
↓∧Y,]A+%
~(∩Aπβ%_A∧YE'3≠¬=_~∀∩A∃%'PA'3π=≥&∩∩m≥≡A!U%
Aπ=!2A≥∃ λ0A∃+'PAπ∨≥LA+ AM3≠¬∨0~∀∪!U'⊃∀A@Y!+¬
∨!2∩$s →'∀A∂ (↓!+%
↓π∨!2↓∨ A!9β≠
~(∪∃%'PA!'3
∨≥&∩$sβ≥λ↓+'
AA+%
A
∨∃' H~∀~∃A≥∂≥⊗Dt∪'↔%!∂
A1!≥ ∩$wπ∂≥LA+ AA≥β≠
↓∪ A≥∃π ''¬%2~∃A≥∂≥⊗Hp∩A!U'⊃∀A@Y!≥π=≥&~∃M3π∨≥Lt∩∩∩$wπ∨≥LA+ A∧A'3≠ ∨_@Z↓!≥β≠∀A→∪'PA∪&A%≤Aα~(@@A¬¬↔!%≡4∀∪'↔%!≤A
→2∩∩w% A'35¬∨_A→% →%'(A 5!)2X↓∂≡A <AαA∂ ~∀∩A)%'(AM3π∨≤D~∀∪'-∪!≤AλY
2H∩∩w∪_A'3≠ ∨_A¬1≠π⊗A→% →%'(A 5!)2X↓≠+'(↓∂ε~∀$A∃%'PA'3π=≤b~∀%≠∨- 4AαY'e≠!≥β5
Q∧R$w!+(↓!≥β≠∀A∪≤AM3≠¬∨0A¬→∨
⊗~∀∪5∨%
A∧Y7'29∨≥
X1'+≥¬=+≥ :s∪≥∪Q∪β_AYβ→+
↓π →_↓∪&A'U≥¬∨+9λ~∧@A1π)A%≡~∀% 1π⊂↓αY'35-εQ∧$∩∩w↓U(A∪≤↓'3≠¬=_A¬→=π⊗~∀%≠∨- 4AαY
→2d∩∩mπ $AM3≠¬∨0A¬→∨
⊗A
%∃ →∪'P~∃'3
∨≤dt%≠∨-'$AαXQλR∩∩w%→∪)∪¬_A!%=! %)dA→∪'PA∪&A9∪_~∀% 1π⊂↓αY↓
→2∩∩w
∨≥&AU A'35¬∨_A! β H~∀β aπ⊂Aα1
2∩4∀@@A9∨!%≡4∀∪!∨A∀A X4∀~∀@A'!
!%≡A%≥)'3`~∃'3
∨≤bt%!+'⊃(A Yβ≥ε~∀∪)%'(AM3π∨≥L~∀
∀m!+%
↓'3≠¬=_Aπ∨9' $~)!'3π=≥&t~)¬β↔!I≡~∀∪¬∨'_AλY≥!
→2d∩∩mπ↔≥&↓+ Aα↓!+%
↓'3≠¬=_A¬→=π⊗~∃9∨!%≡4∀@@AM! π!I≡A∪≥Q'3"~(∩A! M⊃∀A 1∂)≥!M∞~∀∪¬ λA∧1 !
dd~∀∪¬∨&A≥A
2d4∀@@AM! π!I≡Aβ≥Q'3 ~(∪≠∨-∃~AαYM3≠!≥¬≠
Q∧$~∀β≠=-αAα17'2]=≥αW'd]!+$0Y'+≥ ∨+≥ t@w'29!+$A ∪(A'¬3&A≠¬3¬
AI βλ[=→→2~(∪≠∨-∃~AαYM3≠-ε!∧R
∃ β↔!%<~∀∪'-∪!
A→
2∩∩m∪ A'e≠¬∨_↓
% 1∪'(A∃≠!)20A∂∞A⊃≡AαA≥ε~∀∩↓∃%'(↓'3π∨8d~∀∪A+'⊃∀↓ Yβ∂ ~∀β∃I'(A'eπ↔≤d4∀@@A9∨!%≡4∀∩∀~)!≥π∨9&t∪!U'⊂A
a Y(∩$wπ∂≥LAαA!9β∪
A1∪'(A=+(A∨_A!≥¬U ~∀∪5∨% ∩↓αY≥∪0~∀@@e ∪ ↓7≠∨-∃∩AεX!εS:b1!≥¬+_~∃!≥≤dt∪≠=-αA∧1α~∀∪5∨%
AQ(Y!≥ + Zb!εR
∀%∃' APY
/π=→&~∀%!+'⊃(A Iπ=→&~∀%'∨∃∞↓αQ!≥≤d~∃πA1)∀t%∃%'(↓!∨!1Q∀~∀_∩¬'U¬))_%→∪'(ααNBε≤)α∞≡u~⊗JLhP4)@4εnd
∩∩4d
q5⊂∪c⊂!gS)ba)H$iP*Tbb⊂+Rh $gλ*$"P∪$ih⊂∀lij"SW
;9; ONLY A AND B ARE ALGBBERED ANDTHE ARCUMENTS MUST NOP
;8εvA¬∀A! _↓##β≥Q∪)&-→0$(hQemm∧2>Iαt~6*MbαN⊗∃∧RVNQ∧∩⊗~>∀)↓
ε≤z0∃~!Q#\@PssJ7B5∀K P!ε XDD]J'!gg∀P TP∂P∀!gS)P @∪αIL)
NXCKNS: MOVEI B,NIL ;WILL PU@' DAα@ RA∂≥Q_
α¬∧b&NQ∧J1α∧hRb∞>u→h%α-Bε!α⊂b∧$%ZBb∞≡u→α¬α⊂I↓e↓D~0≤U4λ"∧
⊃Q$≤@sPnA→∀Sλλ%⊂#"D∧λ∀tλXt⊂Sd 3Q⊂f+β"PiyTl.A~rr4 d⊂+⊃Hjb".j9r4λ
YS⊃4j4⊃TQ(Y∩4u∧λ34∃ ⊃"B( *Tuλλ→sTlaQ@∧bl⊂d⊂!⊗
TDDNh*j∀'dg*⊃i)P$S⊂!bf∪⊗⊂#bU⊂!b)λ'c⊂#∀"bf$TjεE⊂λ⊂,!j∀)'FEαbl!dλ!⊗##∀DD]aQ)⊂#)⊃bf$iU⊗⊂!gT,P'cλ!bf&λ(#dg∃"i⊂*∪P!εEλ⊂⊂''T)'DDB]P∀!∃j⊂''H'g"P⊂ji)"S*&,P∃ ebiH b+ S* cbH'c⊂$U∀BE∧T'h%⊂∀⊗εEεB⊂⊂⊂)T"ah)∪P$g*⊂Y,εE⊂gg)YN∧d&)λ V!∧BD]b'H*$$iH*'P(∀'j"aU⊂('dS*"i)H#)'fH#aFEαh*id∩⊂(⊗ QaDD]T i#'T&P P⊃`i! QbP!gS&"aj∩ggεEλ⊂⊂''T)'FEαe))jλ!gg)LDD]cSP*),H c`dSεEεE∞]]P*∩$iP)Qj⊂'cλ!gg)Qi)P$TP*$"H)bj⊂⊂k df⊂a&"P∃'P$g∃"i()⊃j"b⊂⊂gb"WβE≥]]H*$"lH&`ebH)ji"H*$ jλ("&⊂∀j`g*∩j$biH"'P'∪j⊂#bU⊂$g*∪P&$iU⊂)j)∃aj*i⊃WεEεB∩'!gS)]∧fSk"dP⊂⊗'$fαD]ijP)⊂_FB∧bl!R⊂ V!βE∩,!Sg)]∧R)h⊂* ("&'∪eDD]Tja)⊂ εE∧bV!d⊂ K!εE∧R)h⊂* ("&'∪eFE∧R))j⊂⊂gg)FBεE&$Tj↔≥∧Pge#P∃⊗&$iU↔≤DDNf)ja∀⊂∀_P ⊂'∀FB∧h'hλ(⊗ DBD]T!Sg)P H!⊂!P⊃∀P≡P
!gg)H P∀!Sg)P!λ∀!gg∀P!P"
TTFEαh*idλ#,(⊗∀∧D]j∩$iP)∪jj$g⊃P&jiU⊂)`k⊃P)⊂ TP!gfT$f"bλ!gb"H!gjg∃)P'gλ$jεEαfgk"H)⊗*∧B]f$iU,→P+Rf&⊂+Pg*⊂!Sjg*⊂∩g⊂)⊂ P f)SP)`k⊃P'k"T⊂("&∪&eFEαe)h⊂∃⊗("&∪&eFEαh*id∩⊂#,( &$ij⊗→D]f∩ij$c⊗P f&λ!*j⊂∪ ij⊂⊂i#VεB∧h'hλ#,(⊗∀εE∧h∪h%⊂( ∧DD]H+dj$λ& ijλ i#P⊂iP#$S f⊂!Q)εEεB≥]]P∃$$iP∀bj⊂'Q⊂!gg∀bi)P∩iP!`S&"b⊂⊃)'fP⊂gfh$S"b⊂!Sb"WεB≥]]P∃$"P⊃⊂b)⊃⊂∪jij⊂∪'j⊂!⊃P P(⊃&⊂(jPg*$j⊗]P*$⊃P⊃!`T⊃⊂$iH("&'∪eSb↔βEεE∩T"&'!N∧j)-⊂P!⊗⊗LFE∩h⊃&,!]αP"l!R⊂!⊗ CE∩h"∪!]∧aPff⊂ K'("&∪∧D]k⊃i,P#⊂ij⊂!R"aeP⊃'i⊂ H("&⊂∪*fa"TεE∧P⊂`ff"H V'(⊃&$εEαP⊂%)∀j⊂∩aSg)FEαh*idλ(⊗*∧B]dc⊂∀)'a P&,P H("&⊂∪*fa"T⊗εE∧R)h⊂* ("&'∪X∧D]H$j∪iH)gP)S'kP*∩ j⊂*∩$iP(⊂i*εEαDDD]H"#biS∪j⊂&Pj*"iλ)gP&Uad⊗εB∧e))U⊂!gg∀DD]P⊂&"j!R"i'jTP$iP∩h⊂$iCEαE≥N]P*$∩iP)bU⊂'c⊂⊂eg)bT)P$iH!`f&⊃b⊂#)∪d¬ COMPILED CODE.~∀lrvAβI∂+≠ 9)&A≠U'(A≥=(A¬
↓! λAE+β≥)%)∪ &8~∀fvlA)⊃ M
Aβ%∀A'→∪≥⊃)→2↓
β')∃$XA'%≥π
APA∪&AU' λA→∨$A∃M \~∀4∀vvv↓
∨$@∃≥π∨≥LXA' ∀A∃+'PA¬
=%α@E¬π↔≥&λ~∀`-,r∞>:≠QαRJT α 1kλ$%mDr∞>:~α¬%↓h∧αD≤yj2∧
i∀bHQ$UD≤yj3PJλ[∧≤Bλ%DλH↔5¬D≤yj2∧
λ%∩βJ¬λ4|u4λ"∧
⊃Q",≤yj3PL
)DJ∧%E∧
HQ$αα¬:λT≥¬)t∧LUH6%Hh$X4|@Tl&A~rr4 d⊂+⊃Hjb".j9r4λ
YS⊃4j4⊃TQ(Y∩4u∧λ34∃ ⊃"B( *Tuλ∧XqsTf1"B1+λrλ⊂EE⊂*"!↔t⊂
jλ(#dg∃"i)P∩dε CELL$ GEP CDR GF FREELIST
XCTPRO
EHCH B,FFS ;CDR FRAELIST, CMPY OF CELL POINTERTO B
NOPRO ; (BUT NM @∨≥∀Aπ+%I ≥)→dA)β↔∃&Aβ Yβ≥)β≥
A∂ ↓∪ R~(∪∃%'P@Q(R4∀~∧@A'!
!%≡A%≥)εed~∀Kπ=→&fT%⊃→$A∧Y∧∩∩$w ≡AQ⊃∪&AQ≡A!¬=) πλ↓!∨∪≥Q %&A→%∨~A≥ε~∀∪A+'⊃∀↓ Yβ∂ ∩∩w↓∃%
∨%4AαA∂¬%¬β∂∀Aπ∂→1 π)∪=≤∩∀@A≥∨!I≡~∀∪)%'(@∃π∨≥&D∩∩g∂<A)%2↓β∂β∪8~∀
∀m)⊃∪&↓%∨+)%≥αA∪LA
∨$↓π∨≠!%→ λA
∨
\A∪(A⊃∨ &A∧A! →9≠⊗Aπ! πεA=≤A¬∨Q⊂Aβ%≥&~∀K e≥&t%!+'⊂↓ Y(∩$sβ→→=.A% Q+%≤AY∪αA!U'⊃∀~(Iεe≥Lt∪ 1
⊂AαYλ∩∩w<)α∞εpαVN∃α"b∞>u→1α
-!α&Q¬:&2⊃∧
2N=∧"=αεrα⊗b∞@h(&*∃~Q↓∩D~6:LhP4(∀Ph(4(hRNV
%"0&:,j
⊗I∧~>*N-∩L4(hP4*~MAIh&U~AαQdJ~&@HIn~2|rV5α$yα~&DrV5α≤z:Z⊗∃~&>9bα~b∞|rM1α∧zB(∀T2&aEPJB>A¬↓2P$HIn~b≤z:M⊃¬""⊗9¬α>B(hR~b∞|rMh$HH%n~MB:V5∧~>*Mαiα6εJαV:&
*&j∀hR~&a h&∞ J≡∃α%!2b"LrV4$KZ&→α<JR"&rαR"∃¬∩ε:≡*α>→α$B∀4(Jα∞ε6<)αRQeY6b2|rV6tKYα
VLbQ6&rαRε
d)α>→¬*:&F,)α~&DrV6M`h(%↓∧RJNQ∧2↑∞>u_$%m¬""⊗9∧r⊗⊗∩p:Qα∩zα¬αJ,
1α∞|rL4(Lj>Z⊗Jα¬2&s↓"RQHH%n*-~QαB
JRST (T)
SPECPRO INTZAX
FWCONS: SKIPN A,FFX ;FULL WORD CONS - ALWAYS CONSES
JSP A,AGC4
EXCH TT,(A)
XCTPRO
EXCH TT,FFX
NOPRO
JRST (T)
FLCONX: AOJA T,FLCONS ;FLCONS WITH SKIP RETURN
FLOAT2: JSP T,IFLOAT ;FIXNUM TO FLONUM, FLCONS, POPJ
FLOAT1: POP P,T ;FLCOJS, THEN POPJ
SPECPRO INTZAX
FLCONS: ;FLONUM CONS
FPCONS: SKIPN A,FFL
JSP A,AGC4
EXCH TT,(A)
XCTPRO
EXCH TT,FFL
NOPRO
JRST (T)
αIFN DBFLAG,[
DBL1: POP P,T
SPECPRO INTZAX
DBCONS: HRRZS FFD ;DOUBLE @RECISIOH Aπ=≥' $4∀∪'↔%!≤Aα1
λ~(∩A∃'@AαYβ≥εh~∀% 1π⊂↓)(XQ∧R~∀@A1π)A%≡~∀% 1π⊂↓)(Y
→λ~∀@A≥∨!I≡~∀∪5∨- ~↓λXbQ∧R~∀∪)%'(@!(R~∃t∩∩w 9λA∨ ↓∪
≤A⊃¬
→β≤~∃∪
∀A ¬
1β∞Y64∃ ¬π=≥&t∪A+'⊂A@Y(~∃⊃¬_bt%≠∨- $AαY#⊃∨+¬→∀∩∩w I%∨$A% A ∨U¬→ &↓≥∨(A%≠!→ 5 ≥) ⊂~∀∩K→βεA≥U~c≠&4∃:∩∩m ∃λA= A∪
∀A ¬
1β∞~∀4∀~∃∪→≤Aπ1→→β∞Yl~∃π1
∨≥0t%β∨∃α↓(Yπ1
∨≥&∩$wπ1π=≥&A/%)⊂A'-∪ A%∃)+%≤4∀~∃π5!_bt%!∨ A@Y(~∀@A'!∃π!%≡↓∪≥)5¬0~∃πaπ∨≥&h∪⊃%%i&A
∩∩wπ=≠!→ `A≥+≠ $Aπ=≥' $4∀∪'↔%!≤Aα1
ε~(∩A∃'@AαYβ≥εh~∀% 1π⊂↓)(XQ∧R~∀@A1π)A%≡~∀% 1π⊂↓)(Y
→ε~∀@A≥∨!I≡~∀∪5∨- ~↓λXbQ∧R~∀∪)%'(@!(R~∃t∩∩w 9λA∨ ↓∪
≤A
1
→β≤~∃∪
∀Aπ1
1β∞Y64∃π1π=≥&t∪A+'⊂A@Y(~∃
≠!_bh∪≠∨-∃∩AαYEπ∨≠!1 0∩w∃%%∨$↓∪&Aπ=≠!→ `A≥+≠ %&A9∨(A∪5!→ ≠∃≥) λ4∀∩K
¬εA≥+4c≠&~):∩∩w∃≥λA∨_A∪
↓π1
→¬∞~∀~(~∃∪
8A 1
1β∞Y64∃ +!0bt∪!= A YP~∀@@↓'! πA%≡A∪9)5β04∃ 1π=≥&t∪!%%5&↓
4∩$w ∨+ →
[!I π∪'%∨∀Aπ=≠!→ `A≥+≠ $Aπ=≥' $4∀∪'↔%!≤Aα1
4~(∩A∃'@AαYβ≥εh~∀% 1π⊂↓$XQα$~∀@@↓1π)!I≡~∀∪∃1π⊂AHY
44∀@@A9∨!%≡4∀∪≠∨Y ~A 0bQαR4∃↔α∪5∨- ~↓)(Xd!αR~∃-α∪≠∨Y ~Aλ0fQαR4∃↔β↔0∪ ≠∨Y ~A)PXdQα$~∀β∃I'(@QPR~∃:$∩w ≥⊂A∨ A%
≤A a
→β∞4∃∪
↓ 1
→¬∞Y6~) 1π∨9&t∪!U'⊂A 1(~∃ U!_bt%≠∨- $AαY#⊃+!→ `∩∩w I%∨$A% A +A→∪π LA≥∨(↓∪≠!→∃≠ ≥)∃λ~∧∩∃
βεA9+~c≠L~∃*∩$w ≥λ↓∨ A∪→
A 1→→β∞~(_∩¬'U¬))_%⊃+≥⊗↓!%∪≠%)∪- L@ZAπa$XA%A→βπ0αaα"VtYr9ybα"V:Zaα"VtZ&~dhP4(4TJ~¬αDr.2>:bl4),BV:- P4)⊗E*:-IPh)⊗",r-MhhQ⊗"VtYQh4R*∞bIPh)εJ¬Ah&2-∩Iαn≤Jb
&"αr:=∧BV:.~α&)α$B&MαdJNA↓jα"V:Zz≥E%z%∧d_;α
eQQ%hH↔8Tt" xb∧LhT∧Dt9It8h!Q hT_ib∧Di9D|:K1PPh(;¬∪P→*5α¬EHeDuf⊃⊂K]8X%∩β!Q M≤9~∧*¬ej%≤-AQ J∧*:α∧2H;¬∪_⊃↔4 DX92∧
(z0hP~)u"¬JABkλQ!∀ $I∀¬%"Eλ"Hh!→%,mλxR¬%EH5E∪!Q LDJ+"∧
E
E"H⊃↔4|$EYe,l(Z$,"λ9tm∧yhTu%4 ∀r∧HXe"∧λ→E4-1Q M∧z "¬αAQ hT9
#∪P→
%∃Rλ∃BE%E⊃⊂K\ZhTrljYT∀-(XB∧≤yZ∧|tYjE~∧→d¬∀Ly
B∧D→Jd-_Q!∃∧⎇ $¬α`Q!PPh**∧d ;β LU:∧¬"dk e3λ⊃↔5≥,*$β_h!~4\MλT¬2u*8U h!∀∧U≥∧λbd≥
&0HK89∧,≤αh⊂*(tc"A_p33∧λk∪TλI∪β"A_p33λT⊂k∪Jλ⊂ε$εB∧P%)∀j⊂↔∃MεE∧Pλ⊂"l!R⊂ V!CEP⊂λ%)h⊂∃⊗("&∪&eDDNidcdλ⊗P&jTj⊂("∪'&eP∃$"P"⊂j*fFB∧P⊂⊂⊃l!d⊂⊂V!FEαi'j⊂∃*⊗⊗XCE∧`b⊃$P** ∀!∀FB∧e*fT#bP*∃⊗)(&⊗→εE∧R)&&P⊂T∀**
FE∧e∀)j⊂!∀"j%∧B]i"j∃i'⊂)Qacg"λ i#FBεE)(∪,→≥∧R))&P⊂V∀**
FE∧e∀)j⊂!∀"j%εBεEεE⊂l)→X∞∧j&'∪⊂*⊗∩⊃)Uk!BD]`P∪$ij⊂bf&⊂∪i⊂+ S*bP!Qf"⊂$TP'e`VFE∧P∩))j⊂⊂l)→XBD]P$Q⊂*$"H$g""V⊂$iP ⊂'i⊂ FE∧e∃fh&⊂∃*⊗!l∀→YFEαa`dcH**⊗_CE∧P%∀)j⊂∀⊃∀FE!V)→XMαbl!dλ V!εB∧h*iR%⊂(⊗∃f$"i∀εE∧bV!d⊂ K!εE!V)→]∧Sgk"dH*⊗∀!
DD]aR"aedS#P)'Uj$g"H#'i⊂⊂l)↔i∀& alβEf)R⊂*⊗⊗Tbcf'QFE∧fSk"P* )j∀*
FE∧j∪''⊂* $'%DB]ibaSe"⊂ T#P&jTj⊂!"H$*g%CEP%∀)j⊂!V)→XεB∧fgk⊃dP"⊗ εE⊂⊂λ→"$cλ-f)dλ"⊗∀*
nX⊗(R*g%XβE∧a`Sf"P" **∧DNc$i)U⊂ i#H&jijλ!"P)S`f&"T⊂*$ SεE∧P∩*fh#QP**⊗⊂l)→Zα]P&"S!j$⊂∪c⊂)bPgg"⊗λ,bj NON-NEGATITE
CXR33: WTA YBAD HUNK IJDEX!]
JRST -3(F)
¬
CXR34: MOVE D,TT ;EVERYTHING IS APPARENTLY OKAY
ROT D,-1
ADDI D,(B)
HRRZ T,(D) ;FETCH COMPONENT IN QUESTION
SKIPCE D
↓ HLRZ T,(D)
CAIL T,-1 ;ERROR IF AN UNUSED COMPONENT
JRST CXR33
JRST (F)
WLHERR2 WTA [INVALID OR URONG LENGTH HULK!]
POPJ P,
;;9 IFN HNKLOG
;;; AXR ROQTINE FOR COMPILED CODE. HUNK IN A, INDEP IN TT.
%CXR: ROT TT,-1 ;QUICK ENTRY FOR COMPILED CALLS
ADDI TT,(A)
JUMPGE TT,%CXR2
HLRZ A,(TT)
JRST (T)
%CXR2: HRRZ A,(TT)
JRST (T)
;;; RPLACX ROUTINE FOR COH !∪1 λAπ=
\~(vvvA!+≥⊗A%≤AαX↓ β)+4A∪≤AλXA∪≥⊃ 0A∪8A)(\4∀vvv↓)⊃
A⊃β)+~↓∪&A∂Uβ%β≥Q λA9∨(A)<A¬
A∧A! _↓# ⊗εu"&Reph(4)-∩BahM∩>Aα%!15DHIf"VtYαNV∃~∞J&¬!α&M¬αεNN,!α&9¬"P4λL
∩∩∀
E"bλ⊃⊂hPα2U)Z⊃q(
J 4J C"A→∀S∪$λK
∃
E#"B)*Tuλ¬
#"AQI0T εNB2
*S(⊂EE∃∃α!Q@2TJ:λ
∃¬⊃"C"G7nh )
3Rd%D 2∃)ilKλ∧Y∃3Rf5λ⊂3HD 2∃)imλ∀Izαj$g⊃iP#'T⊂!gfT$f"bλ!gb"KεE≥]Nβ THESE ALLOCATE @ENKS OF SIZE 1, 2, 3, OR 4↓'+! H[#+∪
↔→2\4∀vvv↓β%∂+5 ≥)&↓∪⊂→αλaα 1∧→1αε⊃ 1α≡,
Jε:$*⊗⊃αtzQαRzα
¬ααλDb¬~X∀u$~I∀-~aQ hRY
Tt[↔!∃≤\~ b¬4X→4E,i1PPJ *%≥"∧Yd≤|h1PPLYzd,Jλ%BD
⊃⊃∪Z,
Yd[
~2α,
Yd[∩D
tM∧∧ tt(⊃3JZq1λλgbh'S g*εβE MOTAI A,-1 8εA¬+PA+≥
=%)+≥¬) →2↓≠+'(↓'⊃+
→→αAβI∂&~∀%∃%'(α↓⊗"VtYH$(hQ⊗":Y∩¬hεE∩JjM∧2~ $KZ"V:Y!α&M¬""* →U∧⎇*H∀u"λ8∃≤(Q!∃¬-9 "¬αH_t_h$∧α∧∀→:¬∀xQ$TE,i6#@!4rr* H⊃S(→r∃3I1!"B$ TTu∧∧0ssJ1"B4i94⊃`λhRβ"A∀∩TTjD 2∪I6P#"A→∀Sλλ%⊂#"A_6⊂r∧λK⊂⊃Hiβ"H∧∧⊗⊂u
Sc"A_6⊂r∧λK⊃QI↓ B1+λpλ⊂%HC"H∧∧∪St
)c"B)*Tuλ¬
#"AQ@εE∩R*g%YN∧fgk⊃dP i T⊂!TBD]d*S%YP$TP%*iU⊂$*g∩Z⊗⊂+Rh ⊂'S ¬ ENUSED @π∨≠↓=→β≥(4∀∪≠∨Y ∩Aε0Zb∩∩lA¬+(ααV*~⎇∩RV:
"⊗2e∧jVNQ¬~"V~4b∃αε∀:L4(LRJNQα*"V:Y 4(Q!PB, i3$ !→¬∃∃*4∧44¬2⊂HK9
Td[D ∃~¬IλR∧LX u∃$→jB∧≤~8PhP~
U≤DαH∀¬H1pc!$λλ⊂H→t∀SaQI2∃)im∞B*9r4⊃dλβ#$∃LFA∧P∩))j %HFK∀A
α HRL AR1( α~(∪ !π Aβ$bαbα
~@YD4 α↓αb∞%αJ<4PJ⊗b∞@∧∧
∪∃Hd4B4⊃PPLYλ4B∧∃H∃∪λQ!∀E∃+)R∧∩F∃∧
HQ!∀E∀IP∧~C∃λ∩Hh$∧α∧tz
$xh!→%∃≥D¬¬"HQ!PS[4λf␈∩∞l↔⊗N}Z2εn≡8λd
_8zn∀≠yH
(14h ≥Yλ∀JYkHλλ←_z_-ly(~∞]Zh_-lλ⊂+AQL¬U@∪βnly mace@LAgK]MJAS\αβ[↔KJβOSK∞s↔¬βF ;⊃↔≤¬v&*aQ$L4d
U≤,HZ5~e1Q hRY d]∀↔!∀E∃+*2∧QRαf⊃ ∧P⊂λ≥a2P≤zy2P≤βign↓EShAαK@~ε|h AQ@4∃*9⊂¬⊂( caFB⊂⊂⊂!⊂eh!'CE∩d'∩X∧R: SKIPG BFH 1
α JRST %HNKRA¬
EXCHA(@FFH+1 +Pick Up sticks
HCTPRO
EHCH A,FFH+1 ;A %. Hq`≥V↓oSiP↓←YHAα≠?;S.sSMβ|1α∧4R↓↓α:⎇αJ<4PJ*JN"↓"Q$hRt4(0$'73HL_ib∧Di9Dl8Q!PTDβRtkε∞B5jH(∩sIzλ⊂(
3R`¬T∩⊃3I:r6Q$≠!"B)*Tu RtvF⊃"R∃)itr6HW@""'~u0TDε( ( @!`f&⊂a&"FB∧h*iR⊂(⊗!Q$l_FB$#%iV_Y∧fSk"dP∃⊗∀ TCEf)R⊂*⊗⊗Tbcf'QFE∧iRdh&⊂∃⊗)j∀∃∀FE∧H%))jλ$'%iV_εE∧Sek"dH**⊗→βE∧j&∪"P*⊗∩'%FEαP%))U⊂↔∃ZβEP⊂λ)adh∪⊂+&`Rd*g%CEP⊂λ⊂('h∩⊂(⊗∧B]i g⊃'fP!Se)biH i"P∪c⊂)dV P→εB∧P⊂⊂∩))j∩'%im εA∧fSk"dP⊃⊗_FEλ⊂⊂→"∩c⊂-f∀d!P*∃⊗∀*∀WX⊗(d∃g%XεB∧`b"∩P"⊗⊗LT TFB$#%iV→]∧iQj!fP∀⊗∀"∀BD]gj∩"i+dTbP!`S!jf U"P&"S#j$εB∧j&'⊃P)⊗⊗LFE∧P∀'h%⊂∀⊗εE∧U)'"P∀⊗⊗XFB∧P)gR P** !h'h∩εE∧iUa$P" _FE∧Tja$P∃*⊗→εB∧e*fT#P** $'%iV→FE∧T*id%λ(⊗+f∩"i)εB∧e))U⊂$'%Tm_FEβ(A)
TLNN A,HNK
JRST FALSE
JRST TRUE
MHUNKE: WTA [MUST BE LIST OR FIXNUM - MAKHUNK!]
MAKHUNK: SKOTT A,FX ;SUBR 1
JRST MHUNK5
SKIPN TT,(A)
JRST FALSE
MOVE T,TT
PUSHJ P,ALHUNK ;INITIALIZED TO NIL
MHUNK7: LSHC T,-1 ;LEAVES THE "ODDP" BIT IN SIGN OF TT
HRLOI T,-1(T) ;SEE HAKMEM FOR THIS EQVI HAK
EQVI T,(A)
TLNN T,-1
JRST MHUNK6
SETZM (T)
AOBJN T,.-1
MHUNK6: SKIPGE TT
HLLZS (T)
POPJ P,
MHUNK5: JUMPGE TT,MHUNKE .SEE LS
JSP TT,AP2 ;STACK LIST ON PDL, -COUNT IN T
HUNK: MOVN TT,T ;LSUBR
AOJG T,FALSE ;CREATE HUNK BIG ENOUGHTO
MOVEI D,QHUNK ; HOLD ALL GIVEN ARGUMENTS,
CAILE TT,2←HNKLOG
SOJA T,WNALOSE
PUSHJ FXP,ALHNKL 9 AND INSTALL THEM
POPJ P,
;;9 IFN HNKLMG
;;; HUNK ALLOCATAON ROUTIJEC
;+; MAKE A HULK - (TT) HAS NUMBER OF ITEMS UANTED.¬
;9; THEN INSTALL THESE ITEIS FROM PDL BY POPPING OFF
ALHNKL8 PUSH FHP,TT
PUSHJ P,ALHUNK ;CREATE A FRESH HUNK$ AND INSTALL ARGS FROM PDL
MOVEI B,(A) 9SAVES C - ALSO USED BY FASLOAD
∀∪A∨ A 1α∩∩∩9'
A1 →⊃≥,@~∀∪)' A(1! ≥5⊗∩∩w
β≤O(↓!+(AA _A#Uβ≥)∪Q2A∪≥Q≡AαA!+≥⊗~(∪⊃%%=~AαX!∧R∩∩m→β'(↓ → ≠∃≥(A∂= &A∪8A!∨'%)∪∨≤`~∀∪M∨'≤AQ(XQ
a R~∀$A∃%'PAβ→⊃9→2~∀%→'⊃ε↓)(XZD∩∩w∪8AλXAM∪∂≤A ∪(A∨8@zz|↓ - ≤↓≥+≠¬∃$A∨ ↓ → ≠∃≥)&~(∪≠∨-∃∩A(X!∧R~∀%β ∩↓(XQ)PR~∀∪∃1π⊂A⊂Y(∩∩m≥∨.A%≤Aλ@4A→β'PA/∨%⊂A∪≥)<A/⊃∪
⊂A)≡↓!∨ ~(∪∃+≠A∂
A(1β→⊃≥1λ~∃β1⊃≥→αh∪!∨ ↓ Yα∩$∩w→∨= A)≡↓∪≥')¬→_AβI∂&A∪8A⊃+≥,~∀∪∃M A(YA →≥≠,~∀∪⊃I→~Aα0QλR~)β→⊃≥1λt∪'=∃_A)PYβ→⊃9→0~∀%!∨ A@Yα~∀%∃' APY! →9≠⊗~∀%⊃%%~↓αXQλ$~∀∪'=∃αAλ1β→⊃≥1α~∀~)β→⊃≥12tA'-∪!≤AY≠β↔⊃U≥⊗~∀$A⊃%→i&@Q∧$~∃β→!≥→0t%!∨!∩↓
1 XD~∀∪ aπ⊂Aα1∧~∀∪A∨!∀A→1 X~(~∀~∀lvvAβ1→∨πβQ
AαA!+≥⊗A= A'∪i
A∪≥⊃∪πβ)∃λA∪≤Q)(R4∀vvvAβ≥λ↓∪≥∪)%β→∪5∀A)≡AQ⊃
@EU≥+' ⊂DA!∨%≥) $PFnn\nnnR4∃β→⊃U≥⊗t∪)+≠!→∀A)(Y¬→⊃≥↔∀∩w!%∃' %-∃&Aβ$DYβ$e∧@ZA'∃
A'+ '(~∀%πβ∪→∀A)(XI?⊃≥↔1∨∞∩w5+'(AA% ' I-
A(4∀∩A∃I'(Aβ1⊃≥↔
4∀∪'+ ∩A)(0b~∀∪)
≡AQ(Yβ→!≥↔λ∩$w' →∃π(Aπ=≥' $↓
∨$A
∨%%
(A'∪i
A⊃+9⊗~∀∩↓∃%'(↓β→⊃≥- ~∃β1⊃≥↔λh∪∃%'PAβ→⊃9↔ ZfT\QλR$w ∪'Aβ)π⊂↓)≡A∪9 ∪-∪⊃+β_A!+≥⊗A
∨∃' I&A¬ 1∨.~∀A%β %0@b`8~∀∪%∃! β(↓⊃≥↔→=∞XA∃I'(Aπ=≥εAβ1⊃≥⊗Ypy⊃≥↔1∨∞Z]I!π≥(x~∀@AIβ ∪0p~∃β1⊃≥↔ h∪'↔∪A
A-≠¬↔⊃+≥,∩∩vb↓∨$@d↓)⊃∪≥≥&@ZAQ '(A→∨$A+M
A∨ ↓π∨≥&4∀∩A∃I'(Aβ1⊃≥⊗`4∀∪∃%∧AαYβ
∨≥&~(~∀vvlA⊃+≥,yS]I∃p|A∪LA)⊃
↓π∨≥'∃$A
∨HA⊃+≥-&A∨ ↓'∪5
e<yS9IKp|↓/∨% L\~∀vlvAS]⊃KpA]<\t@@@@@b@d@@f@@h@@j@@l@@@n@@@p@@@r@~∀lvvA]<XAo←IIft@b@@d@h@@`@@@bX@@fd@lh@@bdp@djl@jbd4∀vvv↓]↑\A%iK[fh@@d@h@@p@bl@fd@@Xh@@bHp@@dTl@@jDd@@b@dh~∀4∀vvv↓+β%≥%≥εB@↓)⊃ '∀Aπ∨≥M %&A5+'(AA% ' I-αA(~∀]'∃
A≠⊃U≥⊗n~(~∃% A β(A!≥↔ ∨≤VbY64∀@@AM! π↓I~Aβ≥Q5β0~)%β ∪`@b`\4∃π∨≥ A∂⊃≥,Y8]%Aπ≥(Xh~∀αA!%%5&↓
⊂V9%!π≥P∩w
→U'⊂A'%∂≤A¬%(@ZA9 λA∧A⊃+≥,A≥∨.4∀∩A'-∪!≤A∧Y
⊂,]%!π9(∩w∪9∪)ββQ
A∂ε↓ +
AQ≡A⊃+9↔&~∀$@A∃'@AαYβ≥εh~∃
∨⊂~
∧
2":Zbq:J∧~:Q1PH%nZ
∩&>V~α"V:Zαε>:≤*JMiαα"V:[↓1α",r-E1αq984PJN.&∧9α¬242!-:∃α∞:PhP%α*∃~Qα∞|r
α≡Dr-2qu∩B∞: h(&"∃∩iαR"a"¬$hRJε∩MA↓`4R↓↓αb≥"BJ<hP&6>4*5αR b~~!ZrJB∞u 4(&≤*R>5αB¬%HIf&V≥!α~&daα&9∧~> - yd,UJ4¬<MI∧¬$DT∧%,uZ8T"∩
tL@U⊃4AQR1SλT PTλ9U $ED∀Q4λX5λ∂ε≠kTTλ9U∂K&∃λ∀q*Is( J*⊂sU¬6*⊂*!QR1Qd¬TT⊂ij ,C ⊃"B3)zQ2(λE *⊂%⊃"B2
)∩(⊃¬E⊂*#!!0S∃∧λ ∂ +uTT⊂ij∂K$%λ*#"KQ"Hλ it∀SaQB4∪j H⊂ ↓QU""'83Qλ xH∀Q*λ05λ Rs∪hq"C"KQ".q)Hλ∪qD 1SH Rs∪hq"@↓A Tu(*∃∪α(~∪s+∧
⊃∩4jEλ∀q*J∪∩4jEλ⊂4j9ph⊂)hλ⊃TI_3Q∀aQC"C!(5∪s'!3∀r∧λ+ 4hXs∪qa⊃.pp)d⊃∪h Jrλ∩λZQ(⊂HXp54hT⊃∪sDzλ∪Q(Xλ⊂4Hq"B4i94⊃q$
u
⊂%⊃".qH→∀q( yS⊗(λitH∪IyK05 y20c!!(∃⊃ ((⊂+λ⊃".hλjQ1+*:∪tP(x(∀∪i→U⊃4J1"B(∧ 3uQ$λ+∃U¬i5⊗"!↔sStIX3∪⊗%D∃ λλ*5λ⊃IzH∪R)Dλuβ!!4∪t $∀ β!!"C"IH5∪s'!"""':rr4∧ 1H⊃*∀∃⊃4jD∩4h
:1QR(913U∧λStHλZ503 ~⊗#"J:⊂5∪iWB2U)Z⊃(⊂%F*∃
!⊃.tri~λ∩1D R3λ¬
r∩0i∧∩4h
;30SiE#"Tjλ5 .A~rsu
D⊂+∀k⊃".sλX5Q4d
⊗4⊃$λR5∀d 3H∃
A"B( *Tuλ¬
#"A→TTu∧ε*∃
!QC"C!*∀T∪
8.B2JY4⊃(λ∃∀∀T i3β"A→TTu∧λP3∀hQ"T∪ ~u∞B*9su∃∧λ+∀v%9∀b"':u0TDε( (λh5⊂r∧
∀StλZU⊗( I4uβ!!(∩TJ:λ∀∀J ∀q#!!2∀TK$⊂+
λ∃#"B* t∩H
¬β"C!*∀T∪I→∞B2
*VH⊂%IR3∀
)t∀b!↔tt⊃(903λ λ0rhλitH∪I→β"B* t∩H
¬β"C!!"TT I6NB)*34⊃$λ+∀T
9R3β!!)5uλ∀∪P4hZC"ThZ∀∪∩*:∞C"A~rsu
D⊂+∀k∃s∀b':u0TDεH (
85λ∀
)t⊃4JK(∪∩*:β"B$ TTu∧
T∪∩+!"B2
*S(⊂EE⊂*#!!33uHT⊂+⊂AQB4∪j H∀ ↓QC"TJ
sR3π!2∀TIT⊂K∪I→∀∀Sj
b".j:⊃0r(→λ∩⊂(9h⊃Sj$∪R3↓QB4∪j H∀ ↓QC"C!*u⊃3JGB33jH2(∃
E
⊂*!⊃.qq*D∀uλYU∀V$λStHλ∀∩3H
Jβ"B)Jrλ∃
E 4q(y∪qb!↔qStD
4q(
y⊃4Q$
t⊂0hT⊃3tHT∩34 zU⊂3JD∃∩⊂)d∃∩3(Q"B3)zQ(∃
E∀u
J
#"A→TTu∧¬∃
#!!"UP)I⊂q.A~u⊂( 9SsK*;30SiD (∃H→∃1+(83∪ )Ipp5 →sH7!QB2TJ:λ∃P)I⊂l#!*P3∪ xnB4
Zrλ∀¬HqR6ε⊃"UP)I⊂l.A→U34λT⊂+∃IHsR3↓QB2Tj∧∃ ∀jλ5∪s!QB(∩J*uλ∃H→∪⊂q!QB2∪
+H∃∃¬E⊂*#!!2∀TK$∃∃ ¬
∃
#!!0p2)d∃∃
:3PSjYQβ"A∀∀q5 $∃∃ ↓QB4∪j H∀ ↓QC"UIHsR3π!33uHY(∃∃¬JSR3↓QB4∪j H∀ ↓QC"@↓A"C"J84tt'!4rr*λ(∃βλ~tt"!↔vr0*:t7#!*p4tixnB3)zQ2(
E∩04j9pc"A~∃4r $∀
E#"B(_3∪⊃Dε
⊂e⊃"B4 z∩H∀¬A"C"H~tspg!4rr*λ(∃β
84tsh1".vi_4tsh;#"P*:t.B)YuQ2$
∩0*:t#"A~∃4r $∀
E"".ejq1(
:qptε∀ (∪*Zuλ∀
(4q4Jh(∀C!(P3∀hW@33jh2(⊂%IR3β!!4∪t $∀ β!!"C"I_4tsh7@33jh2(⊃EJ∀U5 ↓".r)j⊃4SH→λλP*:sphAQB4q*KS(∪(Y5Hα!∃Tq1$λ⊃3⊂*:t#"A→Ttλ
E∪⊂5 y#"B$ TTu∧ 04th6β"R(~tt&A~q5⊗H$⊃K∪(Y5B"%jq1(λH3⊂4j:#"B*9r4∪D
KTThZβ"B$ TTu∧ 04tj_B".hh4uλ
h4Tr)yH∪qDλ4tt$
r5∩∧ Sh⊂iλ0rr)Hc"R(~tplπ!4suHT⊂H⊃Dλ(⊂B!↔p4tiXh∪∪izλ∃r*Iλ⊂rλXpr3Hq"B3)zQ(∃
E⊂C"A→TTu∧ 04th6c"R(~tplg!2∪∀K$∃ ∃↓QB16λ9λ∃ ¬
""'∃∀
( s⊃∀d
u0phZtr5HT∃⊂2)Jh∪qD ∩4u↓Q@33jH3(∃¬I135AQ@∧fgU P"* *εE$Piia[N∧iegU*⊂** &)FEαP%))U⊂$`iTaZεEαfgk)H*∩ ∀∀∀@
SKOTT T$LS
∩A)%'(A%β''εL∩∩f@@@E≥%_DA 9)%∪ LA∂ (↓
fB
~N⊗⊃∧B⊗J∀hP&"2∃Qα 1E!$4(L~ε69∧⊃15EE↓$$↔5S
E¬∀∧D|HJ2∧MHYR∧∀Y→d:¬9zT<EAQ J∧**5"∧_~5≤≥↓Q M≤9~∧bαV!¬αHα".eVJ∀
$λS⊂1dπ(
α$λSt@λ~tt ⊗λ''g⊗J∀P#'T⊂ iiSaFE∧H%))jλ$`iiPYFE∧Sek"P⊂V⊂
!λP)¬
PUSHJ P$EQUAL
MOVS T →! R4PJ*V6∧)α¬2L
NN
_h"&ε≥~εahMα>Aααb (!~∧⎇∧∀
αc_Q!∀U∃:@λ _4qr)@∧EεE∩`iiaM≥∧ieRh#⊂∀∀∀@
JRST IASLMS
JSP T,MEMQER¬
JRST IASSC3
IAS@→∨Lp∪!∨A∩A XP~∀∪!=!∀A0~∀
∀4⊃∪β'M"`t∪5∨% ~↓ 26,jX$λLB2JI∧⊃2P4TJεNN 1`⊂L*YU∧
λ!D:∪t∩A⊃,¬c Tj⊂+"T)` ON OF ASSQ WIP !∧r0~∧9λT9p3QaQ@∧fgUαS T (B) 8ε@@AASLAP
HLRZ TT,(T) ; NOTE - MUST NOT USE OTHER THAN A, B, T, TT
CAIE A,(TT) ; BECAUSE OF ASSQ'S FOR READ CHAR MACROS
JRST IASSQ0
TRNN T,-1 ;SPURIOUS MATCH OF "()" WITH NULL SLOT
JRST IASSQ0 ; E.G. ((A . 1) () (() . 5))
IASWIN: POP P,T
HLRZ A,(B) ;BUT EXIT BY SKIPPING IF WIN, LEAVING FINAL
JRST 1(T) ; TAIL IN (B) - .SEE SSGCP1
;(DEFUN DISPLACE (X Y)
; (AND (ATOM X) (ERROR '|NOT A LIST - DISPLACE| X))
; (COND ((ATOM Y)
; (RPLACA X 'PROGN)
; (RPLACD X (NCONS Y)))
; ('T (RPLACA X (CAR Y))
; (RPLACD X (CDR Y)))))
DISPL0: WTA [NOT A LIST - DISPLACE!]
DISPLACE:
MOVEI TT,(A) ;INSURE FIRST ARG IS A LIST
LSH TT,-SEGLOG
SKIPL ST(TT) ;IS IT?
JRST DISPL0
MOVEI TT,(B) ;CHECK WHETHER SECOND ARG IS LIST OR NOT
LSH TT,-SEGLOG
SKIPL ST(TT) ;LIST?
JRST DISPL1 ;NOPE, SPECIAL TREATMENT
DISPL2: HLRZ AR1,(B) ;CAR Y
HRLM AR1,(A) ;RPLACA X
HRRZ AR1,(B) ;CDR Y
HRRM AR1,(A) ;RPLACD X
POPJ P, ;RETURN X
DISPL1: MOVEI C,QPROGN
HRLM C,(A) ;(RPLACA <1ST-ARG> 'PROGN)
PUSH P,A ;NOW (NCONS <2ND ARG>)
MOVEI A,(B)
PUSHJ P,$NCONS
HRRM A,@(P) ;(RPLACD 81ST-ARG> (NCONS <2ND-ARG>))
POP P,A ;RETURN FIRST ARG
POPJ P,
;; IN FOLLOWING TW FUNS, CAN PUT A "PAGE NUMBER" INTO ACC A WITH 'IMPUNITY'
PUREP: LSH A,-SEGLOG ;find the entry in the segment table
MOVE TT,ST(A) ;(we want the left half too)
TLNE TT,ST.PUR
JRST TRUE
JRST FALSE
WRITEABLEP:
LSH A,-<SEGLOG+SGS%PG-1>
IFN ITS,[
.CALL [SETZ ? SIXBIT /CORTYP/ ? A ? %CLOUT,,A ((SETZ)) ]
CAIA
JUMPL A,TRUE
] ;END OF IFN ITS
IFN D20,[
HRLI A,.FHSLF
RPACS
TLNE B,(PA%WT)
JRST TRUE
] ;END OF IFN D20
IFN D10,[
IFN SAIL,[
SETZ TT,
CALLI TT,400021 ;SEGNUM ON SAIL (TEST FOR HISEG)
JUMPE TT,TRUE
] ;END OF IFN SAIL
CAIGE A,HILOC
JRST TRUE
] ;END OF IFN D10
JRST FALSE
SUBTTL GET, FBOUNDP$ GETD, PUTPROP, REIPROP FUNCTIONS
$GET: JSP TT,GETCHK
JRST FALSE
JFCL ;LET ORDINARY HUNKS GO THRU
GET1: HRRZ TT,(A) ;MUST PRESERVE B, C, AR1, T, D
;(SEE EVAL AT EV3, MKNAM3, SETF1B, .REARRAY, AND ARRY1)
HLRZ A,(TT) ;ALSO PRESERVE R, SEE UUOH1 AND SEE PRNN2
CAIN A,(B) ;ALSO AR2A AND F, SEE FASLOAD
JUMPN TT,GET2
HRRZ A,(TT) ;USES ONLY A,B,TT
JUMPN A,GET1
POPJ P,
GET2: HRRZ TT,(TT)
HLRZ A,(TT)
POPJ P,
SARGET: MOVEI TT,(A)
LSH TT,-SEGLOG
MOVE TT,ST(TT)
TLNE TT,SA
POPJ P,
ARGET: JSP T,SPATOM ;GET ARRAY PROPERTY FROM ATOM
JSP T,PNGE1
ARGET1: MOVEI B,QARRAY
JRST GET1
PNGET: JSP T,SPATOM ;INTERNAL SUBROUTIJE -GET PNAME PROP FROM ATOM
PFGT1: JSP T,PNGE
PNGT0: SKIPN A ;SAVES B
SKIPA TT,[$$$NIL]
HLRZ TT,(A) ;MUST DO IT INTO TT SO AS TO HAVE
HRRZ A,1(TT) ; CONTINUOUS GC PROTEC@)%≠≤~∀%!∨!∀↓ X~∀$Y'
↓π%'$P`~∀~(~∃∂ Qπ⊃⊗t%%∨(A∧X[' ≥→∨∞∩$sπ↓
⊗A
∪I'(AβI∞A
∨HA∂ (0A∂ )0XAβ≥⊂A!+%αJ>@hP&"2bαRQ2≥!"¬$HIfN.M↓↓IαL1α>-b↓Eαε2α:>9m*N⊗I∧BV:-b↓4(M∩>Aα
bN⊗≡dz≤$%Zα⊗"N*α:=α≤Z&@4PJR2:*αRQ2≥H$%nα;∀l∀yD∧M~
:U∧-%ZtLpQ!∩∧U*:Bβ∩
JBHh!~Ddtd
E"dJ1⊂hP∀ %∃≥Dλu$≤6∀hP~IDtr
JBdDi1⊂hP∀ %∃≥Dε"E%E⊃⊂K](Xu,d~$∧dM:@∧M~λi∀t(⊃∪iq"B4
Zrλ⊃K
∃β!!4∃4i H∀
ZtR∪J↓ B2JY4⊃(
E⊗h∀ zλ⊃V
¬∃β"A⊃(λ∩J*uλ %
∃
( Q.pri~λ λitH∪IyK54hZH∩∃)ic"B* tλ⊃K
∃β!(u⊂rf↔@2U)Z∪H⊂%E∃∃α!⊃.sSd
rr4∧¬+(∀H→Q∪s$λTSpAQ@33jH2(⊂%IR3∀
)t∀b':r1r¬D∀t⊃(903λλ84q(λitH
¬∀β"B)*Tuλε%∃∃
!QC"C! ↓A C"HhSu3HJ∞H∪)zQ2(λ%⊃PQ
β"C!(q5∪π↓4rsjJλ⊂C Jc"B$ U34 d⊂K⊃hZ⊃⊃#!(q5∪λ↔@2Tj∧∃∃βλx5⊂r 1"B( *Tuλh3∀q!QB(∩Hhsλβ!(q5∪ε↔@2U)Z⊃(⊂EHP3∀hQ".qIJ4rλλH1q3HZP5⊃$λp4q$ qH∪It∀⊂Sj
c"B)*Tuλx5∪ (⊃"Qq*I ∞B)
TVHλ∃
⊂*!⊃.q4hZh⊂+λ%⊂k∃¬J∃β"A→U34λT⊂+⊂j t∩C!(q1∪ε_,B2
*TH⊂%E⊂*"!↔qq5∧ Q6∃∧ qQH
St⊃**⊗(∪ ~uβ"A→U34λT⊂+⊂j t∩C!!2∪∀K$∃
λ∃#"B)YuQ(λ5⊂C"Hx5∪
π!2∪∀K$∃∃ ¬λj""'9134$ 5λ⊃ zsH∪ ~uλ∪hd∀∀Sj
c"B(_23H
E
∃∃¬⊃"B(
t∩H
¬β"B)
TVHλ5
⊂j!QB2U)Z∪H⊂eHq5∪εA"B2J*uλ⊃hZ∪ β! ↓A NfgP i#Udbg*∀P i"H P)lSa'f⊗λ P# S*bV⊂⊂g"⊂ S⊂ g"∩a`j'T↔εE≥N]P"$⊃P g"∩a`j'T⊂&jiU⊂''jλ!"P H("&⊂∀h`g*∩h,P∀∀"a`f∪⊂*$ U⊂*$"CE_ +; EQNESS OF SUCH QUANTITIES IS UNDEFIH
λ↓∪⊂→ααI∧*∧β⊂3Hz01q$λ3R5h≠*+C!'nnh
I⊃(∃H→∃1( ~h⊂⊃ IS2ihD⊂1H hαabiT`i,Wλ⊂*$"H)lfa∪f⊂&`VP!"P⊂P"$iU∧E≥]NP⊂λKNMSF AS A "DISEMBODIED PBOP@ %)dA→∪'PDvA !
Aπ HA∪&AQ⊃∃αα DM≥E∃`hSαnnd 1H∃ λαP ⊂ROPEBTY ALREADY EXISTS, DHE @≥ \A-β→U
A&~α& 58¬⊂)I⊃1
I⊃4Q%A"NngP#j$⊃i+diQP P'⊃iP )∪h"i*⊗P iP∩dεSDALLEDAT DHE FRONT OF T@E
;;; PROPERTY LIST.A∪ AQ⊃∃αα
$m∧Z*EJ∧→J$, K∀∧-D~:E~∧→`λλ∀∀∪tJI3sC!'nnh XH⊃∩λT∀⊂Sjλ4U⊗$ ∩4u∧
∩⊂5∧ 4h∀
ZQ+λλYβ'jcR⊂'c⊂∃$"P(∃i"P(⊂i*εE∞]]P$TP!gh∩bb⊂ TP$fh∃i"P&∩ij⊂)U)*aj∃i"P*∪P("i∪dj⊂*∩ ¬ @!U)!%∨@\∩∀vlp
α_d¬$DT
d EXT∧|2¬*¬-∀T ∃~∧iyblt→EB¬$λYb¬$λT¬$ JXR∧M4
¬-∀9z¬J<AQ#K[4λ∀t"λI∧*∧hZr¬¬)z∧-∃K∀∧dM:@λλ83∪∀eD⊂1Hλ→T∧V⊂⊂i"P(∃i"VaSβH
' ⊂X∩∀~)!+)!I∨ t~(∪∃' ↓)(Y∂∃)π⊃⊗$∩w
∨I≠β→∪i
A
∪I'(AβI∞~∀∩↓∃%'(↓!%∨!∃$∩∩w⊃∨⊂~Q¬"Je↓∃αVQ
$J2
α|qαJεt">%α5∩0≤∃1Q J∧(h4`H⊃↔2∧dZD∧t|eZU≤-$ ¬,t:4∧<zλI¬∃(Q!∀833λλ%∪T⊃ Iα".iX2q(λ∀∀52(9h⊃⊃*:λ∪sD
⊂⊃(
80ssHD⊂4QjY13U↓Q@(⊂h→3λ⊂EIT⊃∪ ↓".ti 4 3he5∩⊃%X⊃4q**λ⊃⊃*:λ
∃
@dπ CAML'S)
↓ JRSDASET0Q
EXCH B,A ;LOSE - M@+M(A! 1→≠⊗AQ⊃αA4
2V∀hP&*NααQ2B$b26,hP&⊗B≤Aα 2λh*∞N-!BEHLj>J⊗JαQ1"λH4*∞α8U#β!→¬∃∃$
BbEE⊃⊂K\XZ5"¬ JUMPE T,CSET2 ;SEARCH FOR AN EXISTING PROPERTY
HLRZ TT,(T)
HRRZ T,(T)
CAIE TT,(C)
JRST CSET0
JSP D,CSET8 ;SKIPS, UNLESS HAD TO PURCOPY THE PROPERTY
JRST CSET5
SKOTTN T,PUR
JRST CSET4
CSET0A: ;IF PROPERTY EXISTS ALREADY (IN IMPURE CELL)
PURTRAP CSET4,T,HRLM B,(T)
BRETJ:
SPROG2: MOVEI A,(B) ;RETURN VALUE
POPJ P,
;; DOESN'T HAVE SUCH A PROPERTY, SO CONS ONE UP
CSET2: PUSH P,A
JSP D,CSET8 ;SKIPS, UNLESS HAD TO PURCOPY THE THING
JRST CSETP1 ; SO, IF IT MUST BE A 'PURE' PROPERTY ...
CSET2A: HRRZ A,(A) ;PLAIN VANILLA CONSES
PUSHJ P,XCONS
HRRZ B,C
JSP T,%PDLXC ;IN CASE SOMEONE TRIES TO USE A PDLNUM
POP P,C ;ORIGINAL ATOM WAS SAVED ON P
HRRM A,(C) ;SETPLIST TO NEW THING
$CADR: HRRZ A,(A) ;RETURN VALUE (I.E. GET IT BACK)
$CAR: HLRZ A,(A)
C$CAR: POPJ P,$CAR
;; A HAS BEEN PUSHED ONTO P WHEN WE GET HERE
CSETP1: MOVE A,B
SKIPA T,(P) ;GET PLIST OF OBJECT
CSETP2: HRRZ T,(B) ;LOOP UNTIL PURE PART FOUND (OR END OF PLIST)
HRRZ B,(T)
JUMPE B,CSETP3
SKOTT B,PUR
JRST CSETP2
CSETP3: PUSHJ P,PCONS ;pure-cons the words of the PLIST
MOVEI B,(A)
MOVEI A,(C)
PUSHJ P,PCONS
HRRM A,(T)
POPI P,1
JRST $CADR
CSET8: SKIPN V.PURE ;PURCOPY THE PROPERTY IF IT IS OF
JRST 1(D) ; THE KIND FOUND ON 'PUTPROP'
SKIPA TT,VPUTPROP ;SKIP IF NO PURCOPYING ACTUALLY HAPPENS
CSET8A: HLRZS TT
JUMPE TT,1(D) ;FAST, OPEN-CODED MEMQ LOOP
MOVS TT,(TT)
CAIE C,(TT)
JRST CSET8A
PUSH FXP,D ;RET ADDR!
PUSH FXP,T
PUSHJ FXP,SAV2 9SAVES B,A ON TOP OF 'P'
MOVE A,B
PUSHJ P,PURCOPY ;PURCOPY THE PROP VALUE
MOVEM A,-1(P)
SKOTT C,SY 9IS THE FLAG A SYMBOL?
JRST CSET8B
HLRZ T,(C) ;POINTER TO THE SY2 BLOCK
MOVE T,SYMVC(T) ;GET THE FLAG BITS
TLNE T SY.PUR ;IS IT ALREADY PURE?
JRST CSET8B
MOVE A,C
PUSHJ P,PURCOPY ;NO, PURCOPY IT
MOVE C,A
CSET8B: POP FXP,T
JRST RST2
CSET5: SKOTTN T PUR ;SO, PROPERTY IS TO BE PURIFIED!
JRST CSET0A ;BUT EXISTING PROP IS PURE, SO TRY TO CLOBBER
SOVE A B ;BUT IF EXISTING PROP WAS IIPURE( THEN BEMPROP
↓MOVA B,A
PUSHJ P,REMPROP 9 IT AND TRY DHE "FRESH PROPERTY" ROP )
4∀∪!∨@A Y∧4∀∪∃%M(Aπ'∃) b~(~∀v@Zα∞.6*α"-(T∧∃J
U∃%(~α¬<λYb¬%+→∀th∃∪dλs∪pH(4H∩)j∪h⊂)d∃3Uj)5⊃0()⊃(∀λ_q+C!(tq5εGB4∃*9∩H⊃K
∀p*f@εE∧Sgk"dH*⊗∀ JDD]c∪gf⊂(∀'h"i∃,P$iH$g⊂ H(*a"H( cbCE!ibU~ ]∧R))-⊂∃*⊗∀*
DD]aSh,P"S'jcdλ'c⊂*∩ P()∪h"i*⊗P"$iUεE∧h∃id%⊂∀⊗!ibU~!DDNP*'P∀ i&dU⊂*$"H(*`∀PROP
HLRZ A,(TT)¬
AAIE A, C)
↓ JRST CSET4A
↓PUSHB FXP,RST2
JRSTCSET0A
α
REMPROP: 9SUBR 2 - REMOVE PROPERTY FROM ATOMIC SYMBOL
SKOTT A LS+SY
↓ JRST REMP7 ;IUST SAVE AR1,R,F FOR FASLOAD - SEE LDENT
REMP0: SKIPA D,A ;SAVE C, AR2A - SEE DEFPROP AND DEFUN
REMP1: HRRZ D,(T)
HRRZ T,(D)
JUMPE T,FALSE
MOVS TT,(T)
CAIE B,(TT)
JRST REMP1
HLRZ T,TT
REMP20: HRRZ TT,(T) ;A IS GC-PROTECTING THE ATOM
PURTRAP REMP3,D, HRRM TT,(D)
MOVEI A,(T)
POPJ P,
REMP7: JUMPN A,RMPER0
MOVEI A,NILPROPS
JRST REMP0
CSET4C: PUSHJ P,.+1 ;HAIRY WAY TO DO A DOUBLE COPY!
HRRZ A,(T)
MOVE B,(A)
PUSHJ P,CONS1
HRRM A,(T)
MOVEI T,(A)
POPJ P,
REMP3: PUSH P,A ;COME HERE ON PUBE PAGE TRAP
PUSH P,B ;A ON PDL GC PROTECTS ATOM
MOVEI T,(A)
REMP3A: PUSHJ P,CSET4C ;COPY ENOUGH OF PROPERTY LIST
HRRZ TT,(T) ; TO DO REMPROP
HLRZ A,(TT)
CAME A,(P)
JRST REMP3A
HRRZ A,(TT)
HRRZ TT,(A)
HRRM TT,(T)
JRST POP2J
SUBTTL NOT, NULL, BOUNDP _AAβ∪% 4∀~∀~)≥∨)≥=(t∪∃U≠!
A∧Yπ!∨A∀∩∩wI !→β
&Aα↓≥∨≤[9∪_A-¬→+
A 2A(~(∪∃%'PA)%+∀~∀_∩*tzQh∀R":V2cP&*Vmα9α¬d2ε"N(h*RJ,)`&6⎇2∃α¬e2Q:&%H4*∞tzQh&∧zB)ααb:>PhP4(∀Ph*
>,r∩AhLRV6B*α¬2R∃*∀$¬]~V
Iβλ4(→*5α¬EJ5∧
IyPHK8¬∀JX(∩1Hd∃∩⊃$
v30Iyλ⊂4Hz313JD∩4hλ)u3Q↓Q@∧P%∀h⊂*⊗∀'#bXBDYbi∀'i⊂#∪i⊂''Sα-SYMBOLS
HLRZ T,(A) ;GET VAHUE CELL
HRRZ A,(T) ;DO IT INDO T DO PROTECT FROM GC
HRRR T,(A)
λ CAIL T,QUJBOUND
TDZA A,A
MORE A,VT.ITY
POPJ P,
λPAIRP: PUSHB P,TYPEP α CAIE A,QLIST
TDZAA,A
MOVE A,VT.ITY
POPJ P,
λ
∧vlp
mαd
NQ1¬∩V:RLj∀4(hR2εN!P&BV≤B)αAdb2εN$~,$%]~V
Iβ ↓5α<*Qα2
~Qα∞|rMα≡2α¬α∩M~P4λJα*JN α2εN! 4*2
~QUhLj>J∃∧ 2⊂4PJB>BRαA04PH4*2
~QQhL~ε&∃∧115DhP%α*∃~Qα2
~QT$KY↓↓"
α↓α
αq99↓αq↓αiJ↓α∞ε≤(4(&≤Z>RRp∧∧
DJ1⊂K]9t¬<*λIt`9h∪Sdλq∀Td⊃"B( *Tu H4u
!⊃.hλ¬λ( H ¬(λ⊂h~q#"A→∀TVD
∃ ⊂f!".qIyh(⊂)I∪uh
(3Q∪iT∀⊂
)H*#P(⊃&∩⊂#∪i⊂)`RbFE∧PβAILE A,(TT)↓ ; GF THAT KHUDGEY CODA OUTPUDBY THE
CAILE A,(P) ; CKM@LR FOR MAPCAN ETC*
JRSTLASTER
SKIPN TT,(A)
POPJ P,
MOVEI A,(TT)
JRST LAST
LLASTCK: MOVEI F,-1 ;"LONG" LAST CHECK
; REPUBNS <262143.-<NO. OF CDRS TAKEN>> INF
; MUST PRESERVE T,R. SEE APPEND, REVERSE, NTHCDR
LASTCK: SKIPN D,A ;SKIP REPUBN ON NORMAL-FORM LIST
JRST POPJ1 ; LEAVES PTR TO LAST NODE IN D,
SKOTT D,LS ;() IS OK, AND IS ITS OWN "LASTNODE"
POPJ P, ; BUT OTHER ATOMS LOSE
JUMPLE F,POPJ1 ; LIMITED TO (F) CDRS
LAST1: HRRZ TT,(D)
SKOTT TT,LS
JRST LAST2
HRRZ D,(D)
SOJG F,LAST1
JRST POPJ1
LAST2: HRRZ TT,(D)
JUMPE TT,POPJ1
POPJ P, ;ENDED WITH NON-NULL ATOM
;;; REDURN RUNTIME AS A FIXNUM IN MICROSECOND
;;; UNITS (NOT NECESSARILY THAT ACCURATE THOUGH).
$RUNTIME:
PUSH P,CFIX1 ;CUBR 0 NCALLABLE
IT$ .SUCET [.RRUNT,,TT] ICROSECGND UNITS
10$ SETZ TT,
10$ RUNTIM TT, ;RUNTIME INMILLISECONDS
IFN D20,[
LGCKI ;MUST LOCKI OVER ALL JSYS'S
MOVEI 1,.FHSLF ;GET RUNTIME FOR SELF
RUNTM
MOVE TT,1 ;RUNTIME ANMILLISECONDS
SETZB 1,3 ;1 AND 3 HAVE DANGEROUS CRUD
UNLOCKI
] ;EJD OF IFN D20
RNTM1: ;CGNVERT NUMBER FROM INTERNAL UNITS TO USECS
IT$ LSH TT,2
IP% IMULI TT,1000&
POPJ P, ;ANSWER IN MICROSECOJDS
αSUBTTL TIME FUNCTIOF
;+; RE@)U%≤Aα↓)∪≠
↓')β≥⊃β%λA¬&AαA→→∨≥+4A∪≤AM π>t"M84SYemα<)α⊗:$*εZ>∩αR=αl
.∃α$B&MαLr∞J⊗
~∃α⊗|r>R>tJεε2eIαε: αR=αl*εNV∀(4)M[YαR"*αBεN≤
≡∃α|1αJ⊗ aαRεl)0∩α →b¬¬(_5$L8UB¬<T T
J iu"∧XX∃≥-(QPS[74¬∀,→D¬$LXT¬<D→HR¬$λT¬$LXUU≤D~)∀`(h∀v*:⊃3( ~h⊃⊃)Z∪tP*)3⊗(
:∪t∀λX β"G7nh⊂)hλ∃q$
⊃4S)~λ⊂(λy∩5⊂i∧
∀Q*85λ∃ t
(λ~λ∪2(IR1r
D∪qHλX0rλλH0q3((4H f∃C"C!'nh⊃λXp1⊃$ sH∃ λ(λU →14@λ9sTuλ→UλH →U⊃4Jh3λ %T +lf∧∀q0dλStH ~∀kλε∃l, ε∧⊃StDλ Lβ!!"R1Id∩5∀eKc"QλXR3Q$
∪0sJ:λβ"F6 Lλ*H4S2)a"Q⊃(i3Q(
I6⊂sJ:λβ"F6 H5λZS23AQU#"AQR1SDλ L 1"Q⊃(i3Q(
I0sTjDβ"L&ε L∧~⊃4S)→C"QλXR3Q$
∪6⊂ijuλβ!&, ¬d5⊃4IY3C"KQ"C"DJ∩31'!4∃4i∧∀ ⊂hi∪p5ε⊃".tjXTH ∧ Pp3 H0S⊃!QR1SD 5∀wλFL ⊗aQR5 ↓∃TQ∃ →1(∃
Eα".hx5λ⊂)Yu3U∧ qH∃ →1(∀k~u⊃3$ ⊂4hλ(13H
Zβ"R(iH⊃ F¬⊗c"A→∪pri⊃"".iZ4uλ Iprr$λ4Su)hλ∃∩λT∩Tv*1"B5 →1""!↔qq5∧
∩31$
r3PhT∀v4jH3(∪λ~uλ∀HZu⊂4JH1λ∩)d∪4q(:c"B)YuQ(
J #!!4q5 $ +α!⊃.rQ*)h⊂tJXβ"B*YS∪pi9#"W!QLb0h→1q(
J ⊗lf¬JLmFελπ∃→
↔∃→≤ .D]c∪hi⊂+QbeiP∪c⊂_GLX⊂)bPP*$aTFE≥DH%))jλ↔∃YFB≥DijP⊂**⊗⊗YX↔¬ [__↔
→~↔¬ ≤↔.FB≥DP%∀)j⊂↔ YFE∧R)h⊂* $c&'PjεE∧Q + ∩I TT,(TMCNST)
] ;END OF IFN ITS\D∩0 αIFN D10,[
IFE CAIH,[
MOVE T,[%CFDTM] ;INTERNAL DATE/TIIE STANDARD,
GETTAB T0∩∩vA¬&A βQ
XI
Iβπ)∪=≤A∨ ↓ β2~(∩A∃%M(A)∪5
f∩∩l@b[∨I∪∂∪≥∃λA∨≤↓≥∨- 5¬ $@DpX@b`jp~∀%β λAPY6dTLlj\VDZhf\0Y:∩w¬→) $↓)≡@`5∨%∪∂%≤A∨≤↓∃β≥+¬%2@b0bpjL4∀∪∪ %,A(Ylflj\(hVbX1:∩g∂∃(A)⊃%&A≠∨⊂AαA
=+$[3∃β$A∪9) %-¬_~∀∪)' A(1∪
→∨¬(~∀∪→≠!$APY6]∨@@y
' @ZddxXplh@`\`XA:∩gπ=≥- %PA)≡AM π∂≥⊃&~∀∪A∨!∀A@X~∀~))∪≠
Lt∪≠'Q∪∪
AQ(X∩∩m)⊃∪&↓!%∨ Uπ &A≥→∪)π! &AβPA≠∪ 9∪∂⊃(4∀∪∃'@A(Y∪→→∨β(4∀∪
Y%∩A PXPb`@`\`R4∃:∩∩m ∃λA= A∪
∀A'β∪0~∃∪
8A'β∪0Y6~∀%βππ)%~A)(0~∀∪⊃1%4Aλ1)(~∀%∪ ∪-$AλXbHXTfb8∩∩w∪∃β$ZbdlhA∪8Aλ~∀%∪ ∪-$A$XfD\∩∩w5∨≥)⊂4bA∪≤↓$XA ¬2ZbA%≤A ~(∪β λ↓ Y)∪5
pQ$$∩∩wβ⊃λA∪≤↓→+≠¬∃$A∨ ↓ β3&↓!% π∃ ∪≥∞↓π+%%∃≥(A≠=≥)⊂~(∪)→≥8AλXf$∩w'↔% A∪ ↓≥∨(A1 β Ae β$~(∩Aπβ%_A$XH∩∩w'-∪ A∪_A∃β≥Uβ%2A=$A
%+β%d~∀α@↓'+¬∩↓ Xb∩$wβ ∃U'(A
=$Aπ%∃)∪≥∨U&A→ ¬ A3 ¬%&~∀%∪∪+→$A XdPXTfl@`\∩w
∨≥- I(A)≡↓' π∨9 &A
I∨∩A→¬'(A≠% ≥∪∂!(A)≡↓≠∪ ≥%∂⊃(A1β'(A⊃ ε@fD~∀∪)14A)(0Zb~∀%β λAQ(Y ∩$wβ λ↓∪≤A'∃π∨≥ LA'∪≥
A≠∪⊃≥∪∂⊃PA→β'P~∀∪∃M A(Y%
→∨βP~∃:∩$w ≥λ↓∨ A∪→≤A'β%_~∃:$∩w ≥⊂A∨ A%
≤AλD`~∀∪A∨!∀A@X~∀~)∪
≤AMβ∪_Yl~∃)∪5
pt~)554ztb∩∩∩$w/∪→0A'+¬Q%βπ(↓)⊃∪&bA¬β
⊗A 1
!(A→∨$Aβ→) $A→ ∧@ddO&~∃%% A00Y6fb8Xdp\0fb\XL`\XfD\Xf`8Xfb\0fb\XL`\XfD\Xf`8Xfb]t~∀∪5i4~∃5i4z{5i4W0~)) %≠%≤~∃∪→≤A55hZfll8XA/βI≤A7)¬¬→
A= Aπ+5+→β)%-
A ¬3&A∪8A≠∨≥Q⊃&A→=' ':4∃ 1!U≥∂
Ai54~∃t∩∩w 9λA∨ ↓∪
≤AMβ∪_~(_~∃'U¬))_% #+β0A
+≥
)∪∨≤4∀~∃ E+β_t%ββ∪≤↓αXQ∧$∩∩w DA)⊃∪9∂&AβI
A #Uβ_~∀$A∃%'PA)%+∀∩∩v@]'
↓β''∨ @Z@A5+'(AA% ' I-αA 4∀∪≠∨Y ~A 1 #→ 4∀∪!+M⊃∀A 1 #+β0b∩∩w∃#+β_DAβπ)Uβ→→2↓% )+I≥&A∨9→2A∪_A #+¬_~∀∪)%'(AQ%+
~(~∃ βUβ_`T%πβ∪≤↓αXQ∧$∩∩w DA)⊃∪9∂&AβI
A #Uβ_~∀$A!∨!(A X~) #+β0btβ≠=) ∩APXQαR4∀∪≠∨Y ∩A)PXQ∧R4∀∪%∨QεA(X5' ∂→=∞∩∩w≥ (A e! &A= Aβ%≥&~∀∪!%%$APY'(QPR~∀∪5∨%
AQ(Y'(!)(R~(∪πβ∪8A(HQQ(R∩∩m≠+'(↓⊃β-
↓'β≠
↓)3!
↓)≡A¬∀A #+¬_~∀@@@e % A∃%M(AQPRY #1)¬_YE→∪'($∩]' ∀A') %' ~∃%
A⊃9↔→∨∞0∪∃%'PA #→='
~∃%
≤A⊃9↔→∨∞16~∀∪M↔∪!
↓-⊃+≥- ~∧∩↓∃%'(↓ #_c∧~∀∪)1→≤A)PY→&∩$w∪ AY⊃+≥↔@Aπ∨≥Qβ∪≥&↓→∪_X↓)⊃ ≤↓+β≥(↓)≡~∀$@A∃%M(A #1∨'
∩$vA)%∃β(Aβ1_A⊃+9↔&AβLA∪ AQ⊃ 2A] %
A1∪'(A
⊃→&4∀∪'↔=)(Aα1→&~∀$A∃%'PA #→='
~∀%∃%'(↓ #→→M(~∃ E_cαt%'↔∪!8A+'¬!≥⊗∩∩m∪&A)!
A+'I⊃+≥⊗=' ≥ $A
βQ+%
A∃≥β¬→∃λ}~∀$@A∃%M(A #1∨'
~(∪) ≥∀A)(Y!→⊗∩∩m∪ A-!+≥↔ ↓π↔≥ ¬∪≥&APXA)⊃∃≤A/β9(A)≡↓' ≥λ4∀∩A∃I'(A E_c∧∩$rA)⊃∀@E #Uβ_DA5 ''β≥
Aβ ↓ ∪)⊃∃$Aβ%≤A∪&A!+≥⊗~(∪'↔∨Q(AαY!≥⊗~∀$A∃%'PA #→='
~∀%'↔∪!∧~∃ β0c∧t∪∃1π⊂A∧Y∧∩∩m≠+'(↓β⊃/βe&A' 9λA)≡↓
∪%'PAβ%∞4∀∪∃%M(A #1⊂iα~(~∃:∩$w ≥λ↓∨ A∪→≤A⊃≥-→∨∞~) #→→M(t∪!U'⊂A 0QαR~(∪!+' A XQλR~∀∪!→%$A∧XQαR4∀∪⊃→I4A∧X!∧R
∀%!+'⊃(A Y E+β_`$∩wπ∨5!β%
↓ββ%&4∀∪⊃%I4AαX4bQ R4∀∪⊃%I0A∧X@Q B~(∪'+∧↓ Y$n@Vd~∀%∃%'(↓ #+β0`∩∩w
≠∪!βI
Aπ I&~∀~) #→) _t∪ E→→'($∩w ∪M(~∀∪∃#⊃≥+4∩∩w
%1≥+~4∀∪ β1→+~∩$w
→∨9+~~∃⊃∧H∪ E→≥~d$∩w ∨U¬→
~)β0H∪∃#⊃≥~H∩∩wπ=≠!→ `~∃ 0⊂∪ #→9~h∩∩m +!→∃0~¬¬≤H∪ #1↓∪∞∩$s¬∪∂9+~~∀% #→∨M
∩∩wA≥β≠
↓β)∨≠LA≠+'PA¬
A∃"A)≡↓¬
A E+β_~)⊃≤HAI ! βPA⊃≥↔1∨∞Vb0A #→!≥⊗∩w!+≥↔&↓% #+%%
A¬∃π+%'%∨⊂→αdJ.∃αdJNRLhP&⊗FdzN∀$KZJε:$z6Mα r⊃α:Laα6V≥!α
∃∧*EαRzα
∃α-
Vε0hP&⊗FdzN∀$KZεJJ
IαB>LrR⊗J~α6VN"α
¬α- αR≥∧∩∃α⊗
*ε04TJ~9↓rj⊗F2$∩16:%JB⊗Mbα↑εJpαn↑J|r≥α2,r≡R!¬"ε
2-h4(∀TJ~9α%B~2ε:bl4*-
2:5#P4*.λJ6>Z*αQ1ID $4*\λ&6>4)αRQc→"¬$hR.&.`J∩6>4)αQ1∩B¬$4PJεε6rαQ1ID⊃$4(Jα∞ε6*αRQ1~B $Q!∩α∧**5"∧Z→D⎇≤QQ%hH↔8Ttα xb∧Lid∧%DiH∀8h)_dr∧H(dd u85D4H_reXQ(U diV#PLYzd*¬EF∩D
⊃Q J∧8→T*¬EF∩D∩⊃Q Jα *%≥"λZ∀d⎇8QPUh⊃↔4,TD t2∧_ib∧$(iD :8;∧4d_qPT-→Ie,k!→T⎇4T
BbD∃⊃PPL8→Tr¬EE∧∩H⊃↔4≤\Zλ∃∀*λh∀e,Z4∧|2 jTl∀X*0hP∀
∧⎇∧$
α`h(Z∀d⎇8W LlzhR¬αHZ∀e⊃↔5$DT
Te$→X∃$*λh∀e≤~K∩αjλZ4≤
λT∧∀ 91PPL**5"∧h→E≤(⊃↔2¬$t
D⎇α HU4,D t2∧YjE∃J
Ir∧-~X∀b¬y~DB∧h→E≤(Q!PTLid∧∧LyjTje1Q$- H)∀;P→ E∃R
ABD
⊃Q LDJ+"¬%EE∧∩HQ!∀ _T¬"b
JBHH↔8U
,→D∧∀LyjTm~ λ∃4*λZ∩¬≤_ye_h!∀∧U∃:D∧- Iz4(H↔4∧ tDλ4%∃4λ∃∀*λZ∃, D DM≥J4∧|2λi∃DuYZ0hP→
%∃Rλ∃BD
⊃⊃∪\≤λX4Z∧yiEJ∧Z~T bλ8E∃_Q!∀E∃+$∧∩bλ%⊂hP→*%≥"λZ∃, F↓PUh⊃↔4,TD t2∧_ib∧∀_ye,hQ!PTLid∧Dt9It:e1Q$- I d[P~94M∧d
dE,i:hP∀ %∃≥DλU dJ:@hP~94M∧T
U≥∀ i0hP∀ %∃≥DλU d f@hTZ→DDs7!∃¬-9∧¬αd⊃Q M¬Z9α¬αH!PPLYzdtJ
ECλh$∧αβ∀I_b¬\J9α¬"E
E"MV¬E EYi3K:(T dK∀¬≤DzYD"∧(T∧
≤¬D∧∃-D E≤B ~2∧4~:D-∩ yb∧\F⊗hP→
$dJλ%BE"⊃Q M¬Z9α¬αH⊃PPM
Z4B¬¬H hTZ→DDs↔!∀De+$∧
d¬V∩Eα⊃Q LE*+"∧∩E
αHh!→∧e∃$λ"bD%⊃PPM
Z4DR
¬D-
X→Ch!→¬∃∃$λ∩dαV∃¬αHQ!∀E∃+$∧∩b
¬⊂hP→
%∃Rλ%BD∩⊃Q M¬Z9∧R¬¬HU
,→FhP→Yu4*
EBEα⊃Q L x)%α¬EHU d f hP→Yu4,T
BbE¬⊃PPL→z2αk∃
αHh!→%∃≥DλU d f⊂hPQ(U d f#PM:X"¬αJ&sα[AQ M∧z "¬αAQ hTZ→DDsG!∃≤\~ b¬-:)∧tX⊃∀ααβ9≡2π& T¬-≥)
TtZz8Tt$∀ f.∂N↑&*ε]l⊗⊗f\GphP∀∧∧U∃:D∧- I c_H∀∧αβZ∧
fzb =ε.≡4∞FF*∞ ↔↔'1Q$- IεD P~
U≤Bλk¬αdZ→EH∀∧αβ\⎇}G&
≡6ZπM Rπ/<↑"ππ,\FN≡≡LPhP~
U≤Bλk¬αeJAPPM
Z4DRλk¬αe8~c(h!~¬-≤ $¬αeZ:$Du↓⊃∩ααπ86F.=4ε6␈$∞W≡/%]π.v=lW∨_Q!∀U,ZλR¬"HZ∀dDdQ⊂Jα∧π4N∩
mw"b ⎇rεF≤=2εOD f␈⊗\≥FgHQ!∃¬-9 "¬αK:¬-≤∧
αdλQ!⊂J¬λZ4B¬¬K5 -~X∀ehQ!⊂J¬
Z4B¬¬H hP⊃∀∧l⎇ii∩¬"F1PPH∀ ∧≥λ∀q)h∩""$∧λ
tl]Yλ≥
(≠xM,8⎇λ ∀
]
EQLH4X: PUSHJ FXP,RST5M1
POP FXP,TT
POP FXP,EQLP
JUMPE A,EQLOSE
JRST POPBJ
EQLHN5: PUSHJ FXP,RST∃
POP FXP,TT
POP FXP,EQLP
JRST EQLHN3
;; Send a message to a hunk with object in A and message in B
USRSAB: PUSHJ FXP,SAV5M2 ;Save AC's
PUSH P,[RST5M2]
USRAB: PUSH P,A ;Don't save AC's if called here
PUSH P,B
XCT SENDI
;; Check A for being a HUNK and a USRHUNK, Return answer in T
USRHPP: MOVEI T,(A)
↓LSH T,-SEGLOG
MOVE T,ST(T) ;Get segment table entry
TLNE T,HNK ;Is it a hunk at all?
JRST USRHNP ; Yes, call user's hook.
TFALSE: SETZ T ;Nope....
POPJ P,
;; If we are using the USRHNK, assuming we already know it's a hunk.
USRHNP: SKIPE USRHNK ;Must have both a USRHUNK and a SENDI
SKIPN SENDI ; in order to make use of either
JRST TFALSE
PUSHJ FXP,SAV5
PUSHJ P,SAVX5
XCT USRHNK ;Check it out
PUSHJ P,RSTX5
MOVE T,A ;Return value in T, not A
PUSHJ FXP,RST5
POPJ P,
] ;END OF IFN HNKLOG
SUBTTL NCONC, *NCONC, APPEND, *APPEND, REVERSE, NREVERSE, NRECONC
NCONC: TDZA R,R ;LSUBR - DESTRUCTIVELY CATENATE LISTS
APPEND: MOVEI R,.APPEND-.NCOJC ;LSUBR - CATENATE BY CKPYING
JUMPE T,FALSE
POP P,B
APP2~ AOJE T,BRETJ
POP P,A
JUMPE A,APP2
SKIPE V.RSET
PUSHJ P,APRVCK
APP3: PUSHJ P,.NCONC+1(R) ;FIRST INST OF .NCONC IS "JUMPE A,@RETJ"
MOVE B,A
JRST APP2
.NCONC:∪∃U≠!
A∧Y¬% Q∀∩∩]M
AβA f~∀9≥π≥εDt∪≠∨Y ∩A PXQαR$∩w',∩I↓IαA*:∞|r
$∀Rr:∞:≠⊃h&"∃∩aα⊃bBRQ$hP&*Vmα∃α⊃br:∞:≠_4(→
%∃R
JBbDE⊃PPL*YU∧rλJBbth9d≠⊂Q!∀E∃)T∧αbλE⊂hP~ u∧R
¬@hPQ%dt≤h63PL
*$j∧%E¬%"⊃Q M∧z "¬αAQ hPQ%d
¬λYd#P→*Tm∧Tλ∩d∃(ZDPK::T∃∩ε αBT~
∧,tE⊃PPLYzd,Jλ5D
∪⊃⊃∪\4~*5"∧→j5"∧ZZ5"∧(T∧U,ZλR∧
H*$-∧!Q LlzhR∧
&(∩dλ⊃↔4m-:D¬≤
hT¬"dD¬R¬≤XT∧l 9x$dM:APT
ε∪PL J%R∧∃E∧
∪(∃⊂hP~
U≤D$
αd≤yj0hP→
%∃Rλ%BD
⊃Q LE*)R∧
Eλ2Hh!→T⎇4Tλ2dλQ!∀E∃+$∧
∪(∃BD
&(∩Hh!→%,m d∧
∪(∃D
¬ε⊃PT
&~$-$'!PU≥X*3#P→Yu4,∀λ∩bD~&∩Hh!~∧⎇∧$
α`h!Q hU(Zd-∃8W M≤9~∧*¬ej%≤-A↔5≥,*$β
αT
U≤-4λ∩d∩H5E"daQ J¬λZ4DR
¬D
¬*h4Xh!→T⎇4Y∀∧~bλ∃⊂hP→Yu4,∀λ∩dt→A⊂K](Zd-∃8Z2∧
I∃≥"λ+∩∧≤yj4Ltt
Uα∧∀λ4⎇¬⊃Q%∀-f↔ LUYZ∧*∧5H5∧⎇ !⊂KZ xb¬$λT¬$⎇∧ D-∀YD∧LR
(U4
*8R∧⎇(HU⊂h!→∧e∃$λ"bD5⊃PPM
Z4DR
¬ED≤yj0hP→
%∃Rλ5BD~⊃Q LU*:B¬∀Zf⊂hPQ(∃¬∃h93PM
Z4DR
¬E≤
kε0HK8~¬∧,hEu∀-hZ%≤*λ~$=,XYe"∧9λT \→hphU(Zc#P~
U≤D$
αddH~5$≤1⊃∪\mZ:B¬≤~hR¬%EHBe∩λiu∩∧X→eJ¬ H∀≤-4
tDL9↓PPJ *%≥"
(U4-!⊃∪@4⊂p3 D∀Q5HZTq+ijQ5Q**q#"A→TTu∧
Tu⊗ε1"C"IjQ0 "T)b]∧Sgk"dH!⊗'$S∧]ijP)⊂_@ P)"k⊃i)bP⊂P"$iU⊂*idS!P!(∪ ab∪TFE')⊃acg!N∧e*fT"P V⊂)"b%α]iba∀⊂→⊂⊗H∀' ∩ECH∂≥ε↓0A2RtQ≥π∨9ε@A≥I % ¬M
A0R↓2R
∀$A'↔∪A
A,]I' (∩$p
↓↓αiαVN-→α¬2∩b
"Qd04(¬ααBVNDQαA∩
αJZ∞Xh*:J-1EhεE∩Jiα~a"¬$HIf.:eI↓MαLrNBJ,~R&>u→αB⊗⊂αε⊗2b αj>|i∧4(LBJJ5∧⊃1"¬Hh(&*,jB¬α~b∞B>∧P4(εE∩Jiα∩a"
$hP&"J∀iα¬1D→$4(LRV6B*α 2∞∀*R(∀PJ"JJRα¬1α∩H4(εE∩J5α~a" $hP&*Vmα9α¬drJ⊗Yλh(&*∃~Qα
∀*R(4Ph(04*≥*
RR`J≡⊗:≥J5α~,r∞R&|p4(4T:⊗:NLih&*,jB9α"b≡⊗:≥ID4*<*:NeβP&6>4)αRQeYAEA;↓A12<rV6tKZNRεt"εJ⊃∧:⊗:NLj⊗H4PJ6>Z,Iα 1∪$%n<J21αLr∞J⊗l*:Qαu*6⊗JL~ε1α∧
JP4T:⊗:NK⊃h&2$⊃αQ2% $%m∧
:⊃α<JZ∃α⎇*Qα≡,rNf6,!αεR|h4(& zMαPhP&∩B∩αQ2R h(&∞ J≥αQb⊃d4(LRJNQ∧:⊗:NK_4(ε%α α e"P4(L
∩⊃α%!2mA9↓AAAbaBt4PJεε6<)αRQeYMUAβ↓A12hh(&*∃~Qα≡,rNeHhR≡⊗:≥IMh&¬*N!α5BA2Bt∩V_4PJ6>Z*αRQ2<rV44PJ6>Z,iαRQeα:
V0h(&6⎇2⊗%α~bB:
,04(&¬*N")¬↓2B:<r-H4PJB>A∧2bA2∧r
V_hP&B>∧QαA0hP4*≡,rNeEPJ6>Z,Iα⊃2 :⊗:NLh4(ε z*9α bMF↑t
2>N(h*≡⊗u~e]hMα>Aααb∧4(M~.>R"α¬2~@h(&*∃~Qα≡,rNeThP&6>4)αRQbB¬$4PJ*V6∧aαRQd:⊗:NK@4(&lzZ∃α"bmAEβ9AA1d::V6hh*≡⊗u~eYhLJ∩&ZJαRQ1 ↓8$%\J:NR b1↓Q∧"⊗∞&l
1α∩L:&RLhP&ε∩$Iα⊃1∪$%m∧J9α≡,rNf5∧~>V:$*H4(L"B α"bP4(L
∩⊃α"bmA]β↓AA1cαt4(L~ε6≡*αQ2m≠)AAAαa2t4PJ*JN"α≡⊗:≥IX4(LRJNQ∧:⊗:NK_4(4T:⊗:NK)h&Rdr9αR"bNd4PJ*V6∧qα¬2<*:Ne@h(&*≥↓αQ2≤B:YF h(&∩∧⊃αRQeYMUA;↓A12<rV6thP&*J≥!α≡⊗u~e@4P04*≥*
RR`J6⊗6∀*I1αl*6E1¬~V
N h(4*l*6
⊗∪P$$$KZVN⊗~α¬2 d
IE2
⊃J¬2"bRP4U~6⊗6∀*IihLj>Z⊗JαεIEbB¬$$KYα~>∩α
⊗:,2&Qα|1α∩⊗d*R∃hP&6>4*%αε∪∩¬1"∩H4(εU~AαQdbεR≡hh(%αU∩NQαl*6
HhRN6⊗m `&N-"j5αl*6X$KZVN⊗~α¬2 e!26V≥!αBJ-~⊗JZ*αεIEd
IJ¬]~⊗∃α="NB
_h(&B-~!αAd⊂4*6,jEIhM~.>R"α 22_h(%αU∩NQαl*6EPhP&"2∃QαQ1D⊃$4(L~ε69∧ 2P4PIα*J≥!α6⊗m L4(LBJJ5∧⊃26⊗m0$%:≤*∃α∩,bE↓m←+O↔⊃ε Mβ¬α∪CK↔6K?WMn≠↔31∩βCSHhP&"J∃Qα 1D⊃$4(LRJNQ∧j⊗6E⊂h*6⊗m Mh&∧zB%ααaD4(LRJNQ¬~BJ>;⊂4*6,jEQhLRV6B*α 26,jEL4PJ*NA¬!26⊗m
⊗H4PJ*JN"α6⊗6 ⊂4(4Tj⊗6
∪P&N⊗%R5α6,jX4(MαVN!¬↓2λ4Tj⊗6 ∪P&N.⎇"Qαε∪∩¬22_h(%αU∩NQαl*6 PhP&6>4)α¬2
⊃D4(LB2Ji∧⊃1"ε∪∩¬$4PJBVNDQαA2-
Vε0hP&*Vmα9α¬dj⊗6 _h(&"∃∩5αε∪∩¬26,jX4λLBJJi∧
IJ¬bBεIJ
H4(εU∩NQαl*6 HhR6⊗6∪→h&B⎇α%αAcλ4*ε∪∩εJ⊗$Qh4(Lj>Z⊗Jα¬1"
⊃J¬$hP&B>∧QαA⊂hR6⊗6∪!`⊂L*YU∧*λ~#∀
IXTl∪1Q LU:∧¬"dXYU -!Q LlzhR∧
&(∩d⊂Q!∀U∃:@∧l,X& hPQ!PTlYZ∪@M99∃∧*
ee∃≤ZAPPJ *%≥"
9T,m⊃Q$l,Z⊗∪@L*YU∧*λ%D4 J8Rαα∧∧αe≤XT¬$E(8∀⊂K:(U
,~(U~∧XYU
λ
$-≤X*d-~
J@hP→ E∃R
@ ¬λJ#"A_p23D
⊂%⊃"B( *Tuλλ
Q1∩AQ@2∀J+H⊂K¬λJ#"A→TTu∧ 134&⊃"C"@↓A Nng∀∀q0J:∩5∃*H(⊂ λitH⊃*~03λ xpu4J(3Pq*4⊃qHλ$∩3@λ∃C"C!*u0TjGB2Tj∧∃ ∀λI∪S2a⊃.p jP)⊂→FB∧bd!R⊂ V!CEe)T⊂*⊗(⊃&'&eCEbl⊂d⊂ V⊂FE∧iRdh P⊂i_V CE)ja∀X ]∧H)edh⊂P V T_FE∧H⊂)edT P i V!εB∧P⊂⊂∪ek"P⊂⊗ i→⊂FE∧h∃id⊂( !FE∧Sgk"P⊂V!FEαh*id∩⊂(⊗"Th`fεB∧h'hλ(⊗!FB∧e*fT'⊂ F⊂i_i"U%εE)Ua)XMαiegj∃⊂!V&∀DD]c∪gV⊂*∩$iP$S!f*b⊃iP$*S%iPFB∧P%)∀j⊂)h∀'cYFB∧h*iR⊂(⊗!CE$c'λ$'%f∪cV-FB∧j&'⊃P**⊗∩'%FEαP%))U⊂)ja∀j$εE↔]P"g⊃⊂7s⊂∩c'⊂$∪%` OG,
HLRZ C,(C) ;A "PAIR" CELL
PUSHJ P,SUBS0A
EXCH A,(P)
↓HRRZ C,(A)
PUSHJ P,SUBS0A
POP P,B
↓JRST XCOJS
IFN HNKLOG,[
MOVEI A,(C)
PUSH FXP,TT
PUSHJ P,USRHNP ;Check for being a USER extended hunk
POP FXP,TT
JUMPE T,SUBST8
POP P,A
SOVA AR1 AR2A
PUSHJ P,[PUSH P,A
PUSH P,[QSUBST]
PUSH P,AR1
PUSH P,AR2A
MOVNI T,4
XCT SENDI ;Send the frob a SUBST message
]
SUBSH0: RSTR AR2A AR1
POPJ P,
SUBST8: MOVEI R,1 ;R GETS MAX SIZE IN WORDS
2DIF [LSH R,(TT)]0,QHUNK0
PUSH FXP,R ;CNTR WHILE COPYING
PUSH P,R70 ;TEMP PTR WHILE COPYING
MOVE TT,R
LSH TT,1
PUSHJ P,ALHUNK ;CAVES AR1,AR2A
PUSH P,A
SUBST5: SOSGE R,(FXP)
JRST SUBST6
ADD R,-2(P)
↓MOVE R,(R) ;GET WORD OF ORIGINAL HUNK
HRRZM R,-1(P) ; AND REMEMBER RH OF IT
HLRZ C(R
CAIN C,-⊃
PUSHJ P,SUBS0A 9COPY LH
EXCH C,-1(P)
CAIN C,-⊃
PUSHJ P,SUBS0A 9COPY RH
MOVE R,(FXP)
ADD R,(P) ;POIJTER TO NEW COPY
HRRM C,(R) ;INSTALL RH
MOVE B,-1(P)
HRLM B,(R) ;INSTALL LH
JRST SUBST5
SUBST6: POP P,C
POPI P,2
POPI FXP,1
]; End of IFN HNKDOG,
CRETJ:
SPROG3: MOVE A,C
POPJ P,
SUBTTL DELQ, DELASSQ, DELETE, *DELQ, *DELETE
DELASSQ: MOVEI B,DASSQ
JRST DLT0
DELQ: MOVEI B,SMEMQ ;USES A,B,C,T,TT. MUST SAVE AR2A - SSMACRO
JRST DLT0
DELETE: MOVEI B,SMEMBER ;USES A,B,C,AR1,AR2A,T,TT
DLT0: MOVEI TT,-1 ;MUST SAVE R, SEE GCP6H1
CAMN T,XC-2
JRST DLT3
CAME T,XC-3
JRST DLTER
POP P,A
JSP T,FLTSKP
JRST DLT3
JSP T,IFIX
DLT3: MOVEM TT,DLTC
MOVEI TT,(P)
MOVE D,B
SKIPA B,(P)
DLT2: HRRM B,(TT)
MOVEM TT,TABLU1
MOVA A,-1(P)
SOSGE DLTC
JRST DLT1
PUSHJ P,(D) ;MEMBER or MEMQ or DASSQ
JUMPE A,DLT1
HRRZ B,(A)
SKIPN TT,MEMV
MOVE TT,TABLU1
JRST DLT2
DLT1: POP P,A
↓JRST POP1J
DASSQ: PUSHJ P,IASSQ ;SKIPS ON SUCCESS, WITH TAIL OF LIST FOUND IN B
∩A5∨- ∩↓∧Y≥∪0~∀∪≠=-αAα1~∀∪A∨!∀A@X~∀~(]∩⊗e `&N\JB¬α"bfN6,jFt∀Rr∩⊗2-"∃h∀PIα6>4*%α⊃dj⊗6
-⊂4(&¬*N!ααb∧4(MαVN!¬↓2λ∀PJ6.Z,IαRQbiD4(Lj>J∃∧⊃2⊂4PJ*JN"α∩2Q_h(4(hP0 (*:T∃%IA∀4dx~Eαbλi∃EαD e,L(Z%αbλK∃∧-¬D∧ tD
∧$diY2¬∀zZDLTQQ hT~*α∧uYZαbe8i∃Eαβ⊃S X5∀ j30Q**↔0R*Ji ⊗hk
pSEHS ⊃K¬qS
h)W#"Ij34∞A~rsu
D⊂+⊂I~∀c"A→TTu∧λP3∀hQ.pQ*J4SH i3λ∩(d∪Su∧ qH⊃λZr4Q(D∃⊗4λQ"B3)zQ(∃
E
⊂*!↔tQ5
ZSH∃∧ 1H∃iλ5λ∃hT∃p3JEH⊂3
9kλ∃
D⊃q5
4∃∩⊃$ U30HZKC"A→TTu∧
∀U1!↔r1H j30Q**λ⊃q*Jh⊂(λ 1sU)Uλ∃∃∧λq5∀d
∩⊃(λ9tTQ(:λ∀r(yKλ⊂)k5p6!QU⊃4IY3C"AQU⊗4λZ∞B2JY4⊃(λ∃∃⊗4 i3α"':u0TDε( (
Zq4h yS⊗(λ⊃"B4Izλ⊂+¬Zq1s xc"B)
TVHλ∃∀u
λ∃#"B* t∩H
¬β"U ~∪R3π!33uHY(⊂+
~v30Iyβ"B* t∩H
¬β"C!$4v3()s∀∞A⊃".tjXTH !QB2Tj∧∃ ∀jλ5∪s!QB(∩J*uλ⊃H→∀q#!!2TTjD∃∀U(Q"C"AQC"C!!"SS(9l∞B* tλ∀¬H#"SJY0r∩g!"".h9⊃0rd
∪h∀hX(∃∩λ~λ∃q$ ⊂5Q$λ(∪U)XQ4K∧
∩⊃3Dλ6∩5↓QR1Q$ P4R*I ⊗c!(Qi")*tλ∃¬HS∃∀i:β"PHtα2Tj∧∃ ∪Jjrr4↓QPQi↓∀∀∪t $∀ β!!(∩QH9α""'8P3∪
4∩3U t∀⊃∪ irC"KQ".q)hλ∪qD 1Q( h4R5 ↓"R1Id∪P4I~∩ λ
x4SH 9U30i oh∀λI∪S2g{#"TλI∪RrG!0p3)D⊂+∪Jλ∪∪α!↔t⊃∪ irH∂$
⊃∪∪IYkλ∃ λ3H∀ z∩H∀¬A"B(λ833⊃$λ+∪TλI∩β"A∀λ∀∪j H∀ ↓QB33jh2(∃¬Ht∪t !"T⊃ IS2nA_p33∧λ+∪TλI∪α"'8R4TjD⊂(∀*Y0rhλ→Qλ⊃ ~U⊗(λ9⊃0raQB(⊂h→3⊃(λ∃∪T⊃ Iβ"B$∧∩TTjD
∃
!QT⊃∪ i,∞B*)uλ⊂%E4q1iIqb"'9Suh
Ih⊂rλXrh∃ λ(∀u∧λ3U∀K⊃"Hλ∧
t⊃0j
Sh∩)j∀Su↓QB2∪ D∃ ∀jE⊂*#!!4Su∧λ+∀q(y∪qc!$λλ∪Iz∀Sc!!5∪∪Id∃
λ∪∪S!⊃.tri~λ∩1Hd∀⊃∪∧ U30HZC"B$ TTu∧¬∃
#!!4∃4i∧∀ ∃↓QSS2f↔B33jh3(∃
E∀∪S)6"".h[∀⊃0jJh∃⊗*λ(⊂R*Jh∩3D
β"B)YuQ(
J
⊂%⊃"B2
*R(∃¬J∪S2f!".s*Zuλ∀h~Q(∃
A"B5 ISH∃¬HSα"'8R1u*((∪u*D∃r∩(9λ∩r)hλ∪qDλssTd
∪h⊃ q"B( *Tuλλk⊂ssJ1".h¬T⊃R6 j3#"A→TTu∧λS⊂sijb".d¬(⊃S yU3#!!"T∪IYlNB)YuQ(
J ∀∪IYl""':Q4u zQ(∃
D⊃StD
⊃∪∪IYc"Pjλ∪∪Ri'B4∪j H∀
λ∪∪Ri!"@↓A"Tu(*∃∪α(xt∀Sdλ3Qλ
;∩⊂4i↓"C"Hxt∀Sg!2U3*λ(⊂KλxtQ3↓QB0p)→H⊂K
→"".j80ssHD⊂4Qdπ(∂h X03Td sS⊗$λps∪iyc"B)*Tuλλxs∪si1"I1h:∀SnA→3uQ)∀⊂4L%F"".iZ4uλ
85Q(
%⊃H $λStHλh4s∪h_β"Qh:∀L.A_p23∧λ+∩3F¬6∪∪ij3#"A∀⊂p2)H(⊂+ →L
v 3U3%V#"B$∧∀rr*λ#"B$∧λ∀∪j H∀ ↓QB4riz∃λ⊂%Jv#"A∀∩TTjD⊃pt
&C"B)*34∪λT⊂4L%Ht∪t !"B2 JVH∃¬E⊂*#!!33uJ9(∃∃¬Jv+Ph9W∀v%iu⊂b'8ss4 →⊃1λλ9q⊃( h11∀d 1(⊂I~β"B)YuTr$λ ∀v%j∃4B!↔t∃4HT∀v3()sλ⊂IIprhλ 5β"A~⊃∪SDλ
∃¬⊃"B( →tS(
J
∃¬⊃"B4 z∩H∀¬A"Qpj
LNB)YuQ(λ~LP+λ⊃".th~Q(⊂*(c"B*
4r∩D
∀v
r α!↔s⊃0*h4h∩λ~r∩q+∀∩3HλA B3)zQ(⊂%H4LP!QB33jh(∃ λ~L""':∂,λπWH∀Q)H04q%D⊃3∀hT∀∀SjH0uβ!%Qpt
)nB2JY4⊃(λ∃⊂t∪j C"B)Iprr!QB4∃*9λ∀ λ⊃.t∪λ_q4h zR1hλ~Qh∪id∀⊃∪↓QB4∃*9∩H∀¬Jp5VεQ.tp*h4h∪JY(⊂0j1"B4i94⊃(λ%⊃pt
84C"A∀∩TTjD Qpj
M#"A→3uQ)∀⊂+∪I→β"B)YuQ(
J ∪∪j81C"A_1⊃∩$
∃ !QB3∀i∧∃∃ ¬V#"B*
4r∩D
∪2iJp4C!!33uHT⊃ &%⊃V∀¬⊃".tHZu∪tHT∩⊂4i q6( →H⊃β!!33uHY(⊂Kλxt∀p*!"KQh:∀M.A→3uQ$
⊃α!↔p4Qd sH∀¬D⊂3Q∧
p5Q*4∪U3$λ0th yH⊃V
↓"B3
9λ∃ ¬V#"B)_∩5H
E∪∪thXC"B*
4rλλk∀ ∃
A"B3)zQ2(λ∃
⊃V
¬!"B*
4r∩D
⊂⊂*84J⊂E⊃"B4jXH⊃V
¬∀Ml¬6#"B)YuQ3$
K ,eλT∀
!QB33jh(⊂Kλ⊃"B3)zQ(⊂%E∀
"!↔stR(t⊂4Qd sH∀↓Q@4∃*9λ∀ λ↓".th~Q(∀
)s∩4jD⊂U0i85β"A~rr4 d -
λk∀
#!!(∩TJ:λ⊃pj) ""'8sh∀HY⊃04hT⊂∧c⊂⊃& c@∀gP)bU↔αE∧T*id%λ(⊗&bSa"aεB∧e*fT'⊂ F⊃ah)→BD]dj⊃d¬ ALREADY IN PROTECTIVE BUCKET
α SKIPG -4(FXP)
JRST GCPR4
MOVE A,-1(P) ;ORIGINAL ARG
MOVE B,(P) ;CONSED ONTO PROLIST BUKET
PUSHJ P,CONS
MOVE R,-3(FXP)
HRRZ D,GCPSAR
∪∃M A(X9')∨$@~∃∂πA$ft∪!→%4A∧XQαR4∃∂π!Hht∪!U'⊃∧A@Y%')`j~∀∪M+∧A 1$n`VH~∀∪+9→↔!∨A∀~∀~(~∀
∀4∀∩
∃≥π%_bh∪πβ→1 @dYE → Q
∩∩w≥π% →∃β'
~(∪≠∨-∀A$XZLQ
! $~∀∪⊃I%4Aλ1∂π!'¬$~∀∪)' A(0]')∨H`~∀∪)%'(A≥π!$h4∀~∃∂
% _t%) 5α↓β$bY¬$b~∃≥π→∨∨,t∪≠∨Y≥∩AβHbPb~(∪'↔∪A≤A∂πA'β$~(∪∃%'PA
β→M
~∀∪)%'(A≥π!$b4∀~∀
SXHASH: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE
PUSH P,F ;SAVE F - SEE DEFUN
PUSHJ P,SXHSH0
MOVA DT,D
POP P,F
POPJ P,
ATMHSH: ;HASH A PRINT NAME
BNHSH: SETZ T ;HASH A @IGNUM (@'­
Aβ1∂∨%∪Q⊃~R~(∪'↔∪AαA∧Y∧~∃β⊃M⊂bd∩↓⊃%%4↓∧XQ∧$~∀β∃U≠!
AλYβ⊃' d~∀∪!→%4A XQ∧R4∀∪1∨HA(XQ R~∀∪)%'(A¬⊃'⊂b4∃β⊃' dt∪→M⊂A(X4b∩g
=$Aβ)=≠&XAQ⊃∪&A%≥'+¬∃&A)⊃¬(A)⊃∀A⊃β'!↔ 2A%&A!∨M∪)β-∀~∀∪∃I'(@QQ(R~∀4∃≥∪→!'⊂t∪5∨-
A⊂Y6yβMπ∪∩Aq≥∪→8y>Zc:$w⊃β' A≥∪_↓
β' 12~∀∪A∨!∀A@X~∀~)'1⊃' `t∪∃U≠!
A∧Y≥∪→!'⊂∩∩m% )+I≥&A&5 1!$α:Mα"
~".⊗Jα& 2λAPPL
*%R¬JEDλh!→E≤B
JBbm8Xtd|qQ LlzhR¬%EJ5"EJE⊂hS(I∀2∧**5"∧¬
E"JJ;∧E≤¬∃E D~:@Ju8XR¬≥HI∃≥Q*5DE9J3PL
*%R∧%E∧
HQ!∃¬-9∧¬αd!Q LDJ+"∧
Eλ∩Hh!~¬-≤ $¬αe; ¬≤C↓Q M≤9~∧*∧yHE≥Dλ~4EQ!∩¬∀zD∧"bV⊃PPM99∃∧r yD%≥ λ∃≤E↓Q J¬)zB∧"F⊗∩`h!~¬-≤∧λeEαHAPPM zα¬αH⊃PPM
Z4DR
¬E≥D
9βh!~∧⎇αλk¬αeAQ M≤9~∧r∧yHE≥Dλ~4EQ!∩¬∀zD∧"cqQ L HD∧"eAQ M∧z "¬αAQ hP`h*;∧E≤ππ LlziR∧"Eλ∩HK8iD|uYQPPM z∧R¬¬APPh*;∧E≤εw LlzhR∧"Eλ∩HK8i∃DuYQPPM z∧R¬¬APPh)_dr∧)_tu,UK0hU; ¬≤CG!∀E∃+$∧
bλ∃⊂K\)_tu,QQ LU:∧¬%"H)dE≤↓Q LlzhR∧"JAPPM z∧R¬¬APUh⊃↔4,tD t2∧_ib∧∀_ye,hQ!PPh*;∀lE9π hU; ¬≤CW!∀De+$¬"bλ∃⊂K];→T∀|AQ LE*+"∧
F∃¬"HQ!∀U≥∧
E"d~ITE≤↓Q M≤9~∧
∧EJ@hU; ¬≤Cg!∀l⎇hY∩∧"Eλ∩Hh!~∧⎇∧$
α`H↔:$ tIyRb∧~*$
HQ!PPh*;∧E≤π↔ M≥
4e_⊃↔4dM:APPM; ¬≤Cq⊃∪\4≠ e,hQ!∃≥D
9β@H↔8dd|jYPhTH$@M≥
4#λ⊃↔4$⎇X)D(h(;α M; ¬≤≠⊃⊃∪L≤yZ∧d-↓Q$%BA~5DE;&⊂HK8JU∧d[↓PT∀tA∃≥D
9β H↔8$L<jYPhP~;∧E≤εQ⊂K];→T∀|AQ$DrD∧¬∀-λX∃"∧ i4d|u6∩b¬; ¬≠ ⊃↔4E,i:0hP~;∧E≤εa⊂K](→d$|QQ M≥
4C0⊃↔4
∃(≠⊂hT_ibαrZ;∧E≤π∃Tu%~λU~b
x∃∀r :u∀|ht∧d,hzDB¬H_$d-QQ hPQ)∀4rλH$4d_uEXh*;∧E≤F↔ LlzhR∧"F∃∧
HQ)4λL~9α∧"F⊗hUQ⊃∪L,hD∧|2 _dr∧H(dd qQ$L4dλD∀4H_r\≥λiD :K1PU≥
4#∪!_∀$"λEBD
⊃Q M∧z "¬αAQ%hH↔8Tt" xb∧Lid∧$∀iH∀:\;λdd qQ hT_ib∧≥λiD :K1PE≥
4≠ !→T⎇54λBc
λ∃⊂hP→*%≥"
;∧E≤F!PUh⊃↔4,TD t2∧_ib∧≥λiD 8Q!PTLid∧%DiH∀:e1Q%≥D
;# P→Yu4
λEC~D∃⊃PD\⊃_∃≤BλEC Q!∃≥,$λBc∩λ⊃⊂hT8⊃∀l⎇hT¬"c∃λ∩Hh)8⊂L
9¬"c⊗↓PD\⊃≠∧⎇∩λEE h)9∀\`≠ u∩∧EF∩D
⊃Q LU*:B¬≥
4#⊂Q+PHK8Yd"∧xd∧L4dλED4H_phPQ)∀4r d\dxuEXh*;∧E≠_∪ M¬Z9α¬αH⊃PPM
Z4DR
¬E-≥)
¬H∀∧αβ\≡4π&F≡4ε
¬Z8U∀EYi3xh!→%,mλT¬"e9 ¬≠λQ!∃¬-9 "¬αK:¬-≤∧
αdλQ!⊂J¬λ¬4i∧∀ ⊗j~v∩⊂*9↔#"A⊃(∪3jIR(∃¬FC"B!∀⊗⊂u∧
q3Q ≠!"Tk ∩⊂lπ!33uHT⊃
λ∃#"B)*Tuλ
t⊂2AQA"Tk ∀h.A→3uTi∀∃ &⊃"Hλ∧εQ∩1D s∀r∧
∃
E7,
→∃3Rf↓ B2
*R(∃¬E⊂*#!!4∃4i∧∀ ∃↓QB4∃*9λ⊃V
¬∀Ml↓QTv∩
60NB) ∀VHλ∃
∃
!QB4∃*9∩H∀¬Jv∩∀iεβ"B*)uλ⊃¬F#"B(_⊃∪(λE
⊃V
¬!"B)YuQ(
E
∀
!QB2∀J+H⊂+¬
#"A~∃4r $∀ ∀k ∀r ↓Q@01λD⊃
λk∀
#!!4Su∧λ C!!33uHY(⊃ ¬λT∀
!QB33jh(∃ ¬
#"A_3pRJ∧∃ ∀k ∀hλcβEfgU fP* ∀(∀FB∧e))U⊂)d$∀XaεEβE)d$∀Xc≥∧Tja⊂( )≠X∃LεE∧e∀)j⊂(∪h,"%βE*DDNbg"⊂∪c⊂$c∪⊂$'%S'cFEβEβ∧A)jP**&∧S`h($S!P#*S!j$gS)FEεB≥]]P∪`h j∪diP#∃g!`∀IMN
;9; (MAPATOMS FN) CALLS FN RE@EATEDLY, FEEDING IT SUCCESSIVE
;;; ATGMS FROM THE AURRENT OBARRAY. OPTIONAL SECOH
λA¬%∞~∀lvvA'A πβ
% &A∨ β%%βd@Q≠-~Qα
*α¬αN
⊃¬%9ααJ⊗R-∩:MαtJ184Ph*6ε∧
R>6≠P4(→Yu$,∀λBe X~∧
$yZ0hP_→tT:
AE≠
yh∀d⎇8QPPL→y$b¬EJ3∃<h→Dm≤QQ M≤9~∧*¬A⊃⊂K]8X4|TDλ∃∀:λHT4
YJE~¬IqPPJ
U≤B
¬E4|(~%∀
⊃↔2∧≥Z*$,uD t∀
*(∃Hh!→T⎇4Y∀¬%"Eλ4 dDε∩bHQ!∀E∀IP¬%"ER∩Eα⊃Q M¬Z9α¬αJ&sh!~¬-≤∧λeEαK9t∃%9≠%hK9jTl∀Z$∧|2λ*T≤\ZJ0hTX~∧
#↔!∃≤⎇8xR¬%EE∧5E¬⊃⊂K]J@∧<-J4∧∃,98U"∧jYT∀-!Q J∧**5"∧X~∧
#⊃Q LE*+"∧
&⊃Bk
¬⊂hP~)u"¬JEBkλQ!∀De+$∧
d
JE≤
%λ∃∪
⊃↔44-H9α∧∃X94- Q!∃≤\~λt*¬JAPPJ
%∃Rλ∃D¬%J8∃∩D~&∩Hh!→T⎇4YT∧
b
¬⊂HK:8∃4*λ*T≤\ZAPTl~λ∃#∪!~4\M d∧∩b
¬⊂HK9X∃∧≤~$∧$⎇y`∧∃,98U h!∀∧U∃:D∧l
λ~Cλh!→∧e∃$λ∩bD%⊃PPL
*%R∧%E∧∩HQ!∀l⎇hYR∧∩E
αHh!≠∧≥α¬V"Eα⊃⊃∪@8p3∪∧
u0λ(∪$bb⊂⊃*g!j∩gcεEαe))jλ&`h U→εEεB&`h U≤]∧iUa⊂#,∀⊗)≠X
XDD]Ql$j⊗λ)"b*T'$g#H'$fεB∧ijaλ(⊗)≠L∃YFEαe))jλ# f)QFEβεA≥]NP("&λ)j)*Ph*a"H#'i⊂∪`h⊂)Qi$biCE≥]]BV⊗)"U*i'∧B]b"c∃⊂$ f⊃⊂&`lH$ k"H! ej∀ abP∩e#'FB≥]]DK⊗"k"S**`fλ+ f*QDYf"Q*⊂$ S#⊂$ TP" iU⊂'c⊂∃ f*bH&$ijβE→U]Bf$ij DD]iQacg"λ i#FB≥]]DS$ij αD]b$∩i"⊂ T#FE≥N]Df$Tj→DDNc'ji∃$⊂ i⊃FE≥]NDP↔↔ εE≥]NDf$iU'∧D]S ij⊂⊂i#FE∞]]DVS⊗⊗≡ Q")"iTP'c⊂∪$ijλH'g⊂)U ae←βE≥]]Bacb"K⊗&gb⊃DYagQ P""S&)P+R j⊂%Rg"⊂'Q⊂&`h ⊂&gb⊃P*"f∪)P$'UP*'P⊂`f&⊂⊃'εE≥N]DDDNP⊂&gQ P$iH b")⊃iiP'Q⊂(& PbP#d∩ad⊂)Qj)P*T⊂ i#TP#'iλ#'∀FB≥]]DS`h&≠αD]giλ&`la⊃P"`h∪→P⊗P∃$$iP∩iP+d⊃i"P#∪⊂!`f∪⊂)"j∃i')P∃'FE≥N]De!Pf"⊂%K#'∧]Q'≡c$T)j⊂ T#P⊗@∩↑XV→ →V~⊗
V⊂'iλ_[εE∞]]DDB]jbgH$ g"∪"i⊂&PlP!f∪a!"iλ*$$iH+dj$λ P%)∀jεE≥N]DDDNdc⊂'⊃k"i⊃gdg#H*'P!⊃P,!j bb⊗⊂∩!`f&λ'"bbλ''j⊂⊂"P"$⊃i"FEβE&`h∪$ij≥αe)h⊂∃*⊗&`T&_∧]Pgb"P ∧E&`T!`i≥αe)h⊂∃*⊗&`T&_∧DNacb"H_FE∩∪`h≥∧R)h⊂*∃⊗&`h∪_∧D]Pgb"P εE&`T!]∧e∀h⊂** &`h& ∧D]aSb"P→CE&`h⊂gg≥∧R)h⊂*∃⊗&`h∪_∧D]Pgb"P
εE∩&Ph!`g∞∧e)hλ**⊗&Ph&_∧B]agb⊃P~FE∪`h&_∞∧`ge⊃bP*ε∪`h+g⊂DD]f∪ibP$Q⊂'g&⊗P'g"H i#FB∧fgk⊃P"⊗*βE∧`b⊃$P"⊗ T(∀DB]b⊂$⊂iP b⊃)"iiH'c⊂&∩ij_P∪g⊂)j⊂aeFEαd)&$H"⊗∀*
FE∧h∃id⊂( "εE⊂λ⊂→"$Q⊂-fgU)`P*∃⊗∀**
nVXV∪`h&$TjεE∧T*id⊂∀⊗**∧B]i`k⊃P!gb⊃P∩P#∩cji"H'jj⊂∪gb"P∪ j"iβE∧j&∪ P** →∧D]Tedh⊂∩c⊂+bIf&⊂!⊃P)`k∩g#P*T⊂)"iUf*)FB∧P)eRh P K∀"∀DB]bf)QP+bSS&⊂%*Tj⊂)"U*i'⊂⊃$i)jλ&$ijλ iP+⊂f*bFB∧P⊂&Sk)dP⊂V⊗XT⊃∀FE∧Ql!d⊂⊂V⊗XT⊃∀DD]Rg$j⊂⊃k"g*∃`f⊂+⊂f*bP∀f'j⊂ P P'∪kP$ TP#$i∀j⊂ i⊃P∀#'
FE∧e∀h⊂*⊗∀h j'SFE∧P∩))j⊂∪`h&~BD]c'SblV⊂∩h∪iP∪'j⊂ H)lfa∪fεE∧R))-⊂⊂V∀ TCE&`h∪_]∧e∃fh"P⊂V&`h∪~DD]Q'gblK⊂$j∪TP P)Vfa'fλ+dj$λ''P#∃g!b$Sg⊂()∪h"i*⊗FE∧d∪)-⊂! ∀!TFB∧d))⊗⊂!V∀⊂TFE∧R))-⊂⊂V∀!TCE∧a`Rf⊂!⊗∀`i) VDD]i⊃fbfa⊃i⊗⊂)Vfa'f∀P""g∪j$g#H#*g!U$gg⊂∀)'h)CEP!Pdf"P⊂⊗(c"V()∧DNP i"H!gg)Qajj$U"P$gλ)lfa∪f⊂)h⊂abFEαP⊂%)∀j⊂&`T&_FEαa`dbH!⊗(`T) lFB∧P!`Rg⊂!⊗∀ija)βEP⊂∩))j⊂∪`h&~PDD]cSP#$cUi"P'Uj⊂%!Pf&⊂#∪i⊂ P∀ja)⊂∪i⊂ i∀ lFEαa`dbH!⊗(f∀ja)εB∧P%)∀j⊂&`T&~DDNc'gbVV⊂$j iP)gSbj$$S!P+bH!`g∪U⊂&$g∩P*'P∃bf&εB∧h*iR⊂(⊗!S`h&→CEd)∪$P V
%!`f∪⊂_[⊗
FE∧fSk"dP⊂⊗&`h∪→→FE∪`h&_P≥∧d)∀&P!⊗ XT(∀BD]a⊂∩ SAVE IT
PUSH P,A ;SAVE FN (MAYBE WITH BCALL K, IN LEFT HALF)
JRST MAPL2
MAPL3* MKVE D,(P) ;GET FUNCTION CALL FROM STACK
TLNE D,700000 ;SKIP IF IT D@∪ 8O(A∂∃(Aπ→=¬¬ %∃λ~∧∩↓∃%'(↓≠β!_Mα~∀∪5∨- ∩↓λY≠βA_dh∩$w↔⊂X↓/ →_∧A≠∪∂!(Aβ&↓/ →_↓+'
A5∨
~(∪⊃%%4AλXZHQ R∩$rA
∨HA+≥π1∨¬¬ Iβ¬→
↓
≥&~)π∪β!0lt~∃5β!_g∧t∪≠∨Y ∩Aλ1≠β!_X~∀∪≠=) ~A⊂XZbQ@R∩∩w]
A∂≥12A≥ ∃λA)≡↓ ≡Aα↓≠β!_LAπ⊃
⊗A∂≥
~∃≠¬!_lt%≠∨-
↓λXZf! Rα∩mλA!∨%≥)&AQ≡A ∪M(bA∨8A')β
⊗~∀∪!→%4A XZbQ⊂R∩∩w A∂ LA!∨∪9) $AQ~A→βM(A∨ ↓-β→+∀~∀∪∃U≠!
A Y≠β!0j∩∩wQ⊃∪&A%&A% ¬→→2A∧A≠β ↓∨$A≠¬!ε~∀%⊃→→4↓∧XZd! Rα∩m∂ (A
∨
A%≤A→ →(A⊃β1 A∨ ↓∧~∀∪Q→≥
AλXh~∀$A∃%'PA≠β!0p∩∩w5β!πβ8A∨$A5β!π∨8~∀∪!U'⊃∀A@Yπ∨≥L∩∩w≠¬!πβ$↓≠$A≠¬!→∪'P@ZA≥=)
A !β(A∧↓∪&A≥%_~∀∪!%%~A∧XQεR$∩wπ→=¬¬ $↓∪≥)≡↓ ∃λA= A→∪M(~∃≠¬!_mαh∪⊃%→4AαXZDQλR∩$w'β-∀A≥ .↓→β'(↓!∨∪≥Q $~∃5β!_nh∪≠∨-∀A)(X!λR
∃5β!_o∧t∪⊃%I4AαX!)(R∩$w)β↔∀Aπ $↓∨ Aβ1_A→∪M)&~∀%≠∨- 4AαXQ⊂R~∀∪M↔∪!_↓)(Xb!λR~∀$Aβ∨∃∧AλY≠¬!_oα4∀∪≠∨Y
AλYQ(∩∩w9∨.Aλ↓!∨∪≥Q&A)≡↓→∪'(DA∨≤AM)βπ⊗↓β∂β∪8~∃≠βA_dt∪5∨-
AλXZdQ@R~∀∪5∨-
A Y ∩∩m'β-
↓εA
∨HAαA#U∪π⊗A≥ )β/¬2~∀∪A+'⊂A@XZbQ@R∩∩w]⊃ %
↓πβ→_↓)≡A
8A'⊃∨U→λA%∃)+%≤4∃≠β!0dbt∪M↔∪!∞↓αXQλ$∩∩wλ↓!∨∪≥Q&A)≡↓- π)=$A∨ ↓→∪')L~∀∩A)%'(A5β!_dH∩∩w%∃≠ ≠¬∃$X@x5≤XY1a0|A∪LA∃+'PAβ
)∃$@y→%')≤|4∀∪≠∨Y ∩A)PXQαR4∀∪→' A)(X5' ∂→=∞~∀∪M↔∪!_↓'(Q)PR∩∩w∃≥λ[∨_[→∪'PA) 'P~∀∩A)%'(A5β!_h@~∀∪)1≥
A∧0b∩∩wM↔∪ AU≥→ 'LA)⊃∪LA∪&A∧@EπβHDA↔∪9λA∨ ↓≠β ~(∩A⊃→I4AαX!αR~∀%!+'⊂↓ Yα∩$w!+' Aβ%∞4∀∪β∨)αAλY5β!_dD∩∩w∪_A≥∨(↓ ≥λX↓∂≡Aπ! π⊗A=+(A≥∃1(A→%'(~∀4∃≠β!0h`t∪)+≠!
↓αY≠βA_h~∀%→ $f↓7'∪1 ∪(A99∨≤[≥U→_A)∃%≠∪≥¬)∪∨≤↓∨ A→%'(@Z↓≠β Cq:~∃≠¬!_ht%≠∨-
↓ Yε∩$w)⊃∪LA!∨!LA∨
↓
β')12Aβ≥dA+≥≥∃ λ↓')+
_~∀∪⊃1%4A(0ZfQ $∩∩w∂∃(@[≤↓∪≤A(4∀∪'+ ∩A(XP~∀∪⊃I→∩A(0ZbQ($~∀∪β⊃λA YP∩∩∩w→β')→dA!∨ ↓∨
A→≤XA≠=
XA¬→_A→%')&X↓ )ε\4∀∪!∨@A Yα$∩∩w
%≥β_AYβ→+
↓∂∨ &↓∪≤Aα4∀∪)→hAαXZD∩∩w5∃%≡Aβ92A→ →(A⊃β1 A∂βI¬β∂
4∃π≠βA_ft∪A∨!∀A@Y≠β!0f∩∩w!∨∨%βdB~∀~(~∃≠βA_ddt%∃+≠!∀AαY≠¬!_h∩$w≥∪_↓∪&A≥=%≠β_↓ ≥λ[= [→∪M(~∀∪M )5∧↓αY∧∩$w≠β2↓⊃β-
↓∂β%¬¬∂
A∪8A→
PA⊃β→Y &~∀%⊃→%
↓(XQλ$∩∩w(↓∂ )&[≤A∪8Aπβ'∀A∨ A1'+¬$↓πβ→_4∀∪≠∨Y
A)(0bQλR$∩w∂ PA≠∨ ∀@QλAA∨∪≥)LA)≡@p[≤XYa10|A=≤A')¬π⊗R~(∪∃' ↓$XQ)PR∩∩w→∨$A'U¬%&X↓∂∨ &↓)≡A!⊃→αd[8~∃≠βA_dft%1π(@LQλR∩$w∂≡A! %
A→∨$A→M+¬%&4∀~∃≠¬!_dhh∪≠∨-∃~A(YU+)' $∩w∂≡↓⊃β%
↓
∨$AU≥π→∨ ¬ %β →
Aπ¬→_~∀%≠∨-
↓(XfQ⊂R∩∩wMβ%
AM∨≠
A= A)⊃∀A++∨ A)%∨U¬→
A 2~∀∪!%→∩APXQ¬π¬→→ @DlXR∩lA ≥)∃%∪≥∞↓)⊃
AU+≡A≠∃'&A≠=%
A %% π 12~∀∪5∨- ~↓(Xh`4∀∪)→hA(XZD~∀β≠=) ∩AHXb∩∩m$zbA5 β≥&↓→'+¬HAπβ→0~∀∪'∃)5~AU+∨⊂~(∪∃%'PA++∨ aα~∀_∩¬≠¬!_jT%!+'⊂↓ Yπ≠¬!_l∩$s' (↓+ A
=$A+≥
→∨¬¬∃%β¬→∀A
≤A
β→0hP&6>4*%α djεB1∪ 4(→*%≥" X∃∧c_!PPh)X∃∧cX↔ LDJ(R¬"EP %
λ#"A_p31hT∃ ⊗λ∃αZDDNβC@⊃
⊗A
5¬β$A= Aβ%≥&A
∨HA
≤~(∩A∃%M(A≠βA_j∩∩m
∨∨ dXA)∨<A≠β≥dAβ%∂LA
∨$↓'#¬$↓∞ε2`h(&B-~!αAd~6εBc_4(→Yu$jλJBe Q!∀e≤∧
E"cQQ M$β∪hλ∃λ∩Ph→⊂ε∀T∃*∀D]S`ebP∃h⊂%!Pf OF RIGHT # OF ARGS
MKVEI B,PDLA2(T) ;MODA =↓!↓2 ⊃5q
∧z→αε∀:Mx4PJ*JN ∧∧l
F∀⊂H!Q$l
GβPL*YU∧*λ∃Dl
FpHK9h4|T4y∀d~ i∀b∧IxU~¬hZ%J∧I~E$dQQ LE*)R∧
Eλ2HH↔84d|((U∩∧→jDj∧H~5"∧xd¬¬∀Xi∀m-4
DDLhqPPM99∃∧
λee∃≤ZAPPL**5"∧X~∧cD⊃Q LlzhR¬"H⊃PTl~ CD∪!→¬∃∃$
E"b
A⊂HK8→b∧⎇λYbl≤xI∀d~ xb¬$λT¬≥-λZ"l4~:Bα∀H~5"⊂Q!∀U,ZλR¬%EIT
∧Gλ0hP→
%∃R
@ ¬
∃
#!!2U3* H∃ X4∪∞λ↓ B4i94⊂ λ∃∃∃β!)04∪πλnB( YuQ2$λ+
∃¬⊃"B2J*uλ∪(~∪
P!Q@εE&Ph&≤ N∧fgk⊃P*⊗"βEh*Td!⊂( & ijαDYc$S ⊂& Tj⊂'cλ*$$iH'"k@⊃)'aεB∧fgk⊃P"⊗*βEe)∀j⊂&`T&≠ FBεE↔&Ph≥∧e∀h⊂** ↔&`h DYf`T!`gεB∧e)hλ**⊗↔∪`h_DNf`h!SgεE∧R)h⊂*∃⊗↔&`T_D]fPh!FEαe)h⊂∃*⊗↔&Ph_D]S`hεEαe)h⊂∃*⊗↔&Ph_D]S`h!`TεE∧e∀h⊂** ↔&`h D]f`T&$ijβE↔&`T_]∧e∃fh"P⊂V!h'T%αE∧U&'"P⊂V⊗XDNi$b$Pjf'jTP!d"PeP#'T⊂$'i∀$a&"CEP↔∃ f*bBD]P!Sdh$f⊃i⊂&'TibiFB∧h*iR⊂(⊗!α]f$iU⊂$g⊂V⊂#*S!j$gS⊂$g⊂⊗εE∧T*id⊂∀⊗ D]S*fa"T⊂$g∃*⊂$iH$g""VεE∧fSk'$P∃⊗→εE X∩∧iUa$P*∃⊗↔&`T∃`D]S'idg⊃P"_XλPPFE X∩∧fSk')P∃*∧]g∪P'"cPj$k"H)"f'PP f&∪ibb⊂CE↔"f∀bDfgU'$P*∃⊗⊗W&Ph⊗`T∃*∀FEαe))jλ∩&`h⊂`g∀*∃∀FEεBεE)bU≥∧e)T⊂"⊗)Qj!eDB]ija∀⊂→εEαbl!dλ!⊗ DB]c'i∃*g j⊃f,V⊂∪'j⊂*Tbb⊂!⊗P!gfT$f"bλ!gb"CE∧e)T⊂*⊗(⊃&'&eCE∧bl⊂d⊂!⊗⊂FE∧bV!d⊂! i_FB∧e)hλ*⊗↔)Qj_FEαbl!dλ!⊗ i FE∧h∪h%⊂( εEεE∀bj!eN∧e)hλ*⊗)h⊂j'fFB∧P%)T⊂*⊗(∪#bXFB∧e))U⊂∀"∀CEβεE)jP**&∧U i$gUiP!)⊃`eP)∪jj$g⊃iFEεB∩!)"Pe]∧e∃fh"P⊂V!h'T%∧D]J!)"`RP⊗P)Ua)⊂→βE∩!)∩X≥∧fSk"dP⊂V∀!∀BD]`P∂P!)"Peh⊗⊂⊂⊂≡P!∀"`edQεE∧d∀)-⊂! +↔εEαd))-λ i_V∃$h&*TFE∧d∀)-⊂ T→ V+∩b$c#βE∧e)T⊂*⊗)T"aa$S"∧D]Q'P∃'∪j∃⊂!∩g"⊂/∀εE∧DU h)"Q∧D]o∀FE∧DU*,gc⊃∧D]o∃FE∧DU"k f∩'geDNbk f∩'geFB∧P⊂⊂λ_⊂!⊗∃↔∧D]JεE∧Pλ⊂⊂_⊂⊂i_V+∩h&*iB]UFEαP⊂⊂⊂ ⊂ i→⊂V+$b∩c#∧]KFE∧fSi"dP⊂⊗∩""U$abFB∧fgk⊃dP!V∩jg*,RDD]dS*"i'⊂f⊂*g∃,dSbTεE∧fSk"dP⊂i→ V∃)*j$βEe)T⊂*⊗)T"aa$S"εE∧H⊂⊂_⊂⊂⊗*,dS`gεEαP⊂⊂_λ!V*g∃,df`SεE∧Pλ⊂_⊂ T→ V+ j"i(∀$FE∧Tj)*⊂ [V-iRl!$jλ./&]P%h*λn.FEαd))-λ i_V∃&icc∩f"iFB∧j&'H i_V ____ εA∧h∃id%⊂∀⊗∩()∩dεC
STRT 17,STRTCR
MOVA A,TIDIFFERENCE
MKVEM A,VIPLUS
MOVEI D,@¬%→ $s
+≥
)∪∨≤↓)≡A a π+$(4(&¬*N" ¬↓2
J<*8%n≤
R∞!∧
:⊃α-∩JN⊗"αεJ>,r⊃ᬬ∩⊗ε⊃l*Rε1mαJ&:"α2>>α4(&U~Aα→db&:6%4(∀
¬-≤ $¬αd~HU∃¬)⊃PPM
Z4DR
¬E,t)→d h!→%∃≥D
Tt∀→h@hPQ(4∪P~94M∧d
bu∃8Z@K\8→Db∧*(T Z¬TαU∃8ZB∧-*)u⊂h!~∧⎇∧$
α`h!~4\Mλ∀∧αe:∃e∩uJ PhT9ed∀∪!→T⎇4Y∀∧∩e_9bt⊂↔84|UJ)tbl$λ%∀,→1PPM
Z4DR
¬DL|x)d hαB2J*uλ⊂I8ss$AQA"U(HPNB)YuQ2$λK∀5(HB.u)h⊃1R)hαb⊂#∃g!`∀IOJ BREAK
JRST BKCOM
UBVB: MOVEI B,QUBV ;UJBOUND VARIABLE BREAK
JRST@¬↔π∨4~∀4U:Rε PJ6.Z,Iα 2
:R∧%]:J>:8αRfB*α>→α
∩≡V6,rQα
∀*ε,4PJ*JN α∀\9yPhPβ"U(z⊂NB)YuQ2$λK∀5(zα.u)Jq13Dλqh∃λ_h⊂THX2c"A→TTu∧λRpsiQ"C"Jyβ a
αfgk"RP!⊗(UdεA ;WRONG # ARGS BREAK
JRST BKCOM
GCDB~ MOVEI B,QGCD ;FAILED TO GARBAGE-COLLECT ENOUGH SPACE BRAAK
JRST BKCMI
λPDLB: MOVEI B,QPDL 9PDL OREBFLOW BRAAK
JRST BKCMI
CCOB: MOVEI B,QGCO 9GC OV@ %
1≠ ≥α∃∩⊗ε,hP&*J≥!α
.≤z44(hR& <H# LlzhTJ∧%J∀L@pε∧]RUcP&∪ii`cQP!)"PeFE∧R))j⊂αKCOM
~∃→βπ∧t%≠↔- $A∧Y#→βε∩w→β∪→ ⊂Aβπ %≠⊂→α∀*FF⊗≥!α
J,
,4*∀Z∞.5Ph(&B-~")ααb& <x)d H!~4⎇∀Tλ∩∧⊂Q!∃¬-9¬αd8)4≤@,β"A~∃4r∧
∀Mf↓ ¬∧h∃id⊂( +&icQ$f"iCE MOTNI T,2¬
JRSDERRPRIH
(~)↓↔π∨4`t
∀%∃' AHY%' Hd∩∃¬-π↔
DhA≠∨-∀Aβ$e∧Y-
]λ]αα∩m %%∨H[¬% ¬⊗P⊗⊗u2&J>tj⊗*PhP&N∞⎇"Qαε⊃∩¬"∩_h(%αU∩NQα∀Z∞ <T∧c!!2⊂TK⊂ iλK∀ i2(AR2A)
SKOTT AR1,SA
JRST BKCOM3
SKOTT AR2A,SA
JRST BKCOI3
BKCOM4: JSP T,SPECBIND
0 A,VARGS ;SPECIAL VALUE CELL OF ARGS
0 AR1,VREADTABLE
0 AR2A,VOBARRAY
CBKCM0: SETZ A,BKCOI0
PUSHJ P,NOINTERRUPT
MOVEI A,TRUTH
PUSHJ P,$BREAK
BKCOM1: PUSHJ P,UNBIND
JRST UNBIND
BKCOM3: PUSH P,[BKCOM2]
PUSH P,A
PUSH P,CPOPAJ
MOVEI A,IGSBV
EXCH A,VE.B.E
FAC [LOSING VALUE FOR ERROR-BREAK-ENVIRONMENT!]
SUBTTL IJTERN FUNCTION AND RELATED ROUTINES
IJTERN: PUSH P,A ;ONLY ILIT ENTERS INTERN AT INTRN0
INTRN3: PUSHJ P,PNGET ;MUST SAVE F - SEE FASLOAD
SETOM LPNF
INTRN1: SETZM RINF
JSP TT,ATMHSH ;LEAVES ATOM'S HASHKEY IN T
MOVEI AR2A,(A)
HLRZ C,(A)
INTRN: TLZ T,400000
IDIVI T,OBTSIZ
HRLM TT,(P)
IJTRN4: LOCKI ;SO THAT NO INTERRUPT SNEAKS SOMETHING ON DHE
SKIPN D,VOBARRAY ; OBLIST JUST AFTER WE DECADE IT ISNT THERE
JRST INTNCO
MOVEI C,(D)
↓LSH C,-SEGLOG
MOVE C,ST(C)
TLNN C,SA
JRST INTLCO
MOVE T,ASAR(D)
TLNN T1β&y∨ α|~∀$A∃%'PA∪≥)9π≡~∀%%∨(AQ(XZb$∩w∂ PA¬+π- (~∀%∃+≠!0A)(X8Vf~∀%⊃→%4↓αY↓)Q'β$Q⊂R~∀∪M↔∪!α4∀∩A⊃I%4Aα1↓))'¬$QλR4∀∪!+M⊂A
1@Y)(~(∪∃+≠A
AαY5β↔α`4∀∪≠∨Y ∩Aε1α~∃≠¬↔ t∪5∨%
A¬$bYε4∀∪⊃%I0AεX!εR~∀%∃+≠!∀AεY≠¬↔α~∀%⊃→%4↓β$bX!εR~∀%'↔∪!8Aβ$b4∀∩A)I≠αAβHbXHH⊃≥∪_∩$s¬ ∂¬%
A !
A'↔% B~∃5β↔ bh∩@A⊃1%4AβHbXAβHbR~∀%⊃%%4↓β$bXDQβ$b$~∀∪'-∪!≤APY%∪≥_∩∩w¬%≥∧A⊃¬&A5 I≡A/⊃∃_A∪≤↓% ∂+1β$A∪9) %≤4∀∩A≠=) ∩APXQβ$IαR~∃5β⊗dt%∃+≠!∀Aβ$b1≠β⊗b4∀∪∃+5!
A(1≠β↔ 4∀∪⊃→I4A∧X!β$bR4∀∪≠∨Y
A∧X!∧R~∀%'↔∪!8A%∪≥_~∀∩A)%'(A5β⊗h~(∪πβ≠∀A∧Y↓I≥)≤d$vy ≥⊂A∨ AA≥β≠
xQ(R~(∩A∃%M(A≠β- ∩wπ=≠!β%∀A
∨$↓%∪≥)∃%≤~∀%β∨∃α↓(Y≠β,f~∃≠¬⊗ht∪!→%4A⊂XQ(R$wπ∂≠Aβ%
A→∨$A%∃∂+→βHA∪≥)∃%≤~∀%πβ≠
↓∧XQλ$~∀∩A)%'(A5β↔ ~(∪⊃%%hA(XQPR~∃≠¬⊗ft∪!%%4A¬$bXQ¬$bR~(∪∃%'PA≠β⊗H~∀_~∀~)≠β↔αLt∪⊃%I4AαX! R∩@@@w≠¬↔
A≥∃.A ≥Q%2A∪9)≡A∨ β%%βdA
%∨4Aπβ→0A)≡A%≥) %8~∀β≠=- ∩AλY"K∪M~∩@@@vAβLA∨!!=' λAQ≡A%∪9) %≤4∀∪!+M⊃∀A 1∂ (b4∀∪∃+5!
Aα1≠β↔αM∧~∀∪!%%4A∧XQ R4∀∪≠∨Y ∩A∧1→∪_~(∪!+'!∀A Y
∨!3'e≠¬∨_4∀∪⊃%I~AαX! R
∃5β↔αgλtA⊃%I4AαX! R
∀%'↔∪!≥
A→!9 ~∀∩↓∃%'(↓≠β↔αH~∀∪'-∪!
AλY,]!U%
∩@@@w∪9) %≤↓≠β↔ LA!+¬∀A'2d↓∪ @UA+%
{PAβ≥λ↓≥∨(AM3≠¬∨0~∀∩A
β∪≤AλY#'35¬∨_~(∩@A∃I'(A≠¬↔αgα4∀∪!+M⊃∀A 1!'3π=≥&~∀%∃%'(↓≠β↔αH~∃≠β-αgαt%!+'⊃(A Y'eπ∨≥&4∀∪∃%M(A≠β-αd~∀4∃≠β↔∧`t∪)⊃5αAλ1λ∩wλt`@z|↓¬+π↔∃(A/βLA ≠!Q2A¬ →∨%
AQ⊃∪&A
β→_~)≠β↔αh∩A≠∨Y ∩Aλ0b~∀∪5∨-≤A Y%∪≥_∩w≠β-
[+ ↓≥ .A¬)∨~~(∪∃+≠A
AεY5β↔αf4∀∪!+M⊃∀A 1!≥∂≥,~∃≠β-αdt∪A+'⊃∀↓ Y≥π=≥&~∀%≠∨-
↓)(XQ→1 R~(∪∃+≠A
AλY5β↔αj4∀∪⊃%I~AαX!β$bR$w∃π∨9εA∂≥Q~A ≥⊂A∨ A +π↔ P~∀∪∃I'(A≠¬↔αh~)≠β↔αTt∪⊃%I4AλYY∨¬β%Iβ2~∀%∃+≠!0A)(X8Vf~∀%⊃%→~↓αY↓)Q'β$Q⊂R~∀∪M↔∪!α4∀∩A⊃I%~Aα1↓))'¬$QλR4∃≠β↔∧ht∪'-∪!αA Yα
∃5β⊗bt$A∃+≠A≤A(Y5β↔ ∩mβ)∂~↓
∨+≥⊂A∨≤A=¬→∪'P~∀∪⊃1%4Aα0QεR~(∪!∨ ↓
1 YQ(∩wπ!∨+→λ↓ 1∪(↓+∪)⊂↓_∞
R∀aα
V≤Z⊗Q↓~α&)α% 4(&≥* αAe⊃]A-λh(&Vtb.B>∧P4(4P0$ [Yeα∞|j∃αα-∩∃αRzα&*R-∩9αεrαεR>jα↑">≤)αBJLrQα: j∃αε~α&)α∧r
V→ph(4*∀J:R⊗∀qh4(L~ε69∧→2mM+↓]AAbbB:
,2t%n≤
Z⊗M∧04(%∧RJNQ¬∩&:Rsλ4*JLrR9APJBVNBα~bAe 4(&¬*N!ααbεBb$P4(&¬*N!ααb∧%n,rR⊗JLr≥α&u"⊗J9∧
~R⊗∩αR"∃α∩BVNBαAα¬∩aαN≥∧jVNQ∧"=αλZ$(h!~4\M D∧e∧haPPJ *%≥" →e%∀f⊃PPL_HDJ∧5F⊂hP→
%∀jλ5E∀uIf hR∧∧β∀$_d¬\lzhTJ∧5E∧~MV¬E∧t*X`hP→Yu$tTλ2e∀→h`hT→jE∀s'!∀l⎇hY∩∧~J d∃,a⊃∪\%Z DL≤~HR¬∧h→T*∧λ~4DLht∧ dyz$M$ QPPLYzd*¬EJ∧t∃Xa⊂KZλ~2¬-8XB∧Ld
5DD~9hP→Yu4rλEE∀LhaPPM9y$d*λEBr[1Q MDz$¬"e h%,2λE⊂hP→*%≥"¬eS⊂h!→E≤B
EBkλQ!∀U∃:D∧LuJ)`hPQ*$LUIf∪PM99∃∧b J∧t0Q!∩∧U*:B¬∀→jDsQ!∀l⎇hT¬%"J d∃,aQ M∀zD¬%"FaPPL_HDJ¬JECd|*J4MR6↔b{⊂↔42
~ x%%≤≠$∧m-:D∧∀
xD h!→T⎇4TλBe4x(∃∃∀≠⊃PPL*YU∧b
JBbr61PPL J%R∧∃Hβ
DE⊃PPM99∃∧λQ!∩∧E*+"∧
Hε∩D"⊃Q LUYZ∧r∧∃H5∧⎇ !PPM
Z4B∧k
αe%AQ M¬Z9∧R¬¬J$LUIfhP~ uα∧k
αe%AQ LlzhR∧"Jit∀
*(∃Hh!→%,m D¬%"Ea3_h!→¬∀dTλ∩dβ∃λBHh!~∧⎇∧$
α`h!→¬∃∀Tλ∩dβ∃λBHh!~∧⎇∧$
α`h!Q `H!Q$L@4∪∪hH,C"A~rr4λ∀∃ ⊂j)3U⊃*)B.tjXTH !QS02ih3*B)YuQ2$
∀∪HyRl"!↔tp
a∀⊂_FEαe*fh⊃P V&Rg&ZεB∧h*iR⊂(⊗*βE∧h*Td⊂(⊗∀"& i⊃FE∧d∀)-&@⊂T∧RDLARG
MOVEI T,MKNM1
PUSHJ FXP,MKNR6C
POP P,RDLARG
ARINTERN*
POPJ P,RIH
) I_∩∀~)≠↔≥~Dp∪'↔%!≤Aα1% βI∞~∀∪A∨!∧A@X~∀∪!%%4AλXQαR4∀∪≠∨Y ∩A∧1% →βI∞~∀∪!→%$A∧XQαR4∃≠↔≥4dtβ∃M A(Y
⊃≥,b4∀∪∃%M(A!∨A∀b~∀4∀∩∃%⊃_bdt%≠↔- $A(Y%%→) ¬8~∃≠↔9~ht∪M )5~↓!≥¬+_~∀&U~AαR b&J∩λh(&*∃~Q↓""H%nBt:2-E∧zIαJLrR⊗Jp¬B¬$λYb¬∧z "¬αββ"AQ@εEεB≥]]@⊃bj⊂!R i aU i⊂'∃db`∩I@εA-β1+
4Ph*∞αu1FahM"2=α aD4
≤B:YEPJN.>%!α¬2≥I.~`hP%α*∃~Qα∞DrQF hP&RIib¬%EJ5Hh!∀∧U∃:@∧9⊃UL(⊃ Pr jL1εA→∪∀VD
∃
λ∃!"B)
TVH
J *
J
#"A→∪∀VD
∃
Jλ#"A→⊃⊂@⊂∃*∩-YMX≠X_ ⊗⊂**
nBE∧R))b @π⊃
E⊂∀λhRε"~3
¬h→Yu (αP ∀T,(A)
TLNL T,1
CHNV1B:
λSA% T@FNTT,[-200@:4⊃'αH%)↓:pαRQ2ZiEAA¬h4(∀ %∃≥D¬¬"HQ(4Dud_3@MzH∩¬\izB∧
89∀J∧9λ∃∀ 8HU∩
QQ LU*:B∧≤ jcλh!Q `H*:T∃%IA∀$ h∧∀IZλ⊂3HD⊃⊃1JYA"C!'nnh
I⊃(⊂H~p0h _⊃0( XH⊃⊃(j∀St∧ 4nC!'nnb%λ⊃1U)d⊃⊃1J
Stλλh6∀∀D¬⊗
#!'nnb$∧λλλ∧∧
⊃∪d¬
(
¬ U3∪∧¬∀Q3*
Stλ¬λp4@ ¬(
⊂h_⊃∀H ¬***%⊃"Nng⊃(λλ∧∧λλ
5∀∀Izλ
⊂h~H⊗∀H∀!`b∀⊂,∀P
!`b"∀⊂,∀TJFE≥]NP*$ U⊂$iVλ)"fgU P∃ S&⊃⊂'Paja)⊃g!biH'c⊂*∩ P )∪h"i*⊗P!"c∪i"FE∞]]P(∃j*$g⊃P'g⊂∃$"P'⊃kP+ S*bWεBεE""Q()'h∞∧DD]Q"l()βE)"h⊃`j⊂→ ∧h*iR⊂(⊗ CEe)T⊂*⊗"⊃()→εB∧P%)T⊂*⊗"⊃()_FB∧P⊂%∀)j⊂"⊃("iεB∧d))⊗⊂**⊗
!TFEαe*fh∪⊂**⊗⊃!("iβE∧d&∀-⊂ V
TFEαd&)-λ i_V
!∀FEαd&)-λ!⊗∀!JFE∧fSi"dP⊂T∀!∀CE≥alSIN B *AND* C; PROPERTY VALUE IN AR1.
DEF1: MOVEI AR2A,(A) ;DEFUN COMES IN HERE
DEF1B: PUSHJ P,REMPROP ;REMPROP SAVES C, AR1, AR2A
MOVEI B,(AR1)
JUMPN A,DEF1B ;REMOVE ALL OCCURRENCES OF THE PROPERTY
MOVEI A,(AR2A)
PUSHJ P,PUTPROP
DEF9: POP P,A ;PUT NEW VALUE FOR PROPERTY
POPI P,1
JRST $CAR
DFPR2: HLRZ B,(A) ;SOME HAIRY CHECKS FOR DEFPROP AND DEFUN
SKOTT B,SY ;SKIPS ON *FAILURE* TO GET A VALID SYMBOL
JUMPN B,1(T)
JRST (T)
DFPR1: JUMPE A,(T) ;MORE HAIRY CHECKS FOR DEFPROP AND DEFUN
HRRZ B,(A) ;SKIPS ON *SUCCESS*
JUMPE B,(T) ;LEAVES STUFF SPREAD OUT IN A, B, C
HRRZ C,(B)
JUMPE C,(T)
JRST 1(T)
;;; (DEFUN <SPEC> <FLAG> <ARGS> . <BODY>) DAFINES A FUNCTION.
;;; <FLAG> MAY BE OMITTED, OR MAY BE "EXPR", "FEXPR", OR "MACRO".
;;; <SPEC> MAY BE A SYMBOL (THE NAME OF THE FUNCTION), OR A LIST OF
;;; TWO TO FOUR SYMBOLS (IN WHICH CASE THE FLAG "MACRO" IS ILLEGAL).
;;; <ARGS> IS A NON-NIL SYMBOL OR A LIST OF SYMBOLS; THE FORMER INDICATES
;;; AN LEXPR (INCOMPATIBLE WITH THE "MACRO" AND "FEXPR" FLAGS).
;;; OTHER FORMATS FOR <ARGS>, IJCLUDING APPEARANCE OF & KEYWORDS,
;;; CAUSES THE EACRO "DEFUN&" TO BE RUN INSTEAD.
3;;
;;; IF THA VALUE OF THE SWITCH DEFUN IS T, THEN THE EXPR-HASH HACK
;;; IS ENABLED. INTHIS CASE, DEFUN AVOIDS MAKING THE IJTERPRETITE
;;; DEFINITION IF HASHING THE DEFINITION IJDICATES THAT IT IS
0⊗vlA)⊃
↓'β≠
↓β&A)!
Aπ+I% ≥(0A!% M+≠β¬12Aπ∨5!∪→ ⊂XA →∪∃∪)%≠≤\~(vvvAQ⊃αA-¬%∪∨+LAπβ'∃&Aβ%∀t~∀vlrA
∨I~A∂ y'! |t~∀lvv∪
=≡∩αQ→∨≡A¬¬$R∩Q→∨⊗A¬¬$A¬βhR∩Q
=≡A¬βHA¬β4↓##+0$~∀vvlA 1!H[⊃β' A!%∨A %)2↓∪&A∨8A)⊃
↓β)∨~h~∀fvl∪
∨≡$∩Q∂ P@O
∨<@O¬βHR∩@@4A≥∨≥∀@Z∪
=≡~∀vlv∩∩∪m∪ A)!∪&A∪LAαA'e≠¬∨→t~∀vvlA 1!H[⊃β' A!%∨A %)2↓∪⊂~∩L~εR>∩α&MhhQmmlL*bBIlBεN L*bBIlBεN J↓↓5αtz:¬↓hJFVV@h)mmZα∩⊗~,qαBV%→αR"*α~V:≥"&>9∧"⊗~&tJR&>rα>9α4z=αVt"⊗Iα$B∃αB∀zB⊗J%Ih4)[Yd&⊗EαI>~-BBI>l
∞J=α↓α
ε⊂H&
ε⊂H&
ε⊂h)mmZα∞>6∧J2⊗I¬αVRM¬""¬α5*:∞RLz9α∩,2&:&$J>9α|qα~>zαV:∩-⊃αR"*αBJ>∧*JRePh)mmXJNV
∩z~NV∃⊃>2N,∩I↓↓∧∩εI↓PJ
εhHJ
εhhQmmmαQαR"*αBJ>∧*JRe¬:&21∧∩∃ᬬ~f6
|aβr~|yα
ε↔aα↑"L~!α&rαRVJph)mmZα↑&2bα"εZ*αR"∃∧
BBJ⎇αJ&ε$)αNV∃⊃>~N,∩I>2≥*
Iα¬∩>B⊗∃"e84Ph*∩⊗5*9h4U∩⊗B⊗
!↓I1¬αVN!¬↓2∧4T"⊗→]PJ"JJRα¬1"
H4(εDbJiα
⊃E1"
H4(&≤
&9α
⊃E2F-BBH4PIα*J≥!α∩⊗3_4(ε≤
&∃α
⊃E2F4*bBHhP%α∞ J9αε∪ 2F6 ~J<4PI↓α*∃~Qα∩,1L$%ZB∩⊗~,q↓rN∧*
y↓d22ε≥r↓999Hh(&6⎇2⊗%α
⊃E2F-BBH$KY"∩⊗5*9↓r≥α⊗
yαq99%Z↓r~2 9yα∩,2εV2%→αR=∧*bBHhP&6>4)α¬1E↓$4)[b~2ε;qα&M∧J9αε∪ eαRD)α∞∩∩α>→α
α&M↓CbεJ≡≠q↓99rIeαRD)α∞ε∩α>→↓E↓%α&~↓rNB,→y84T"⊗→MPJ*NA¬!2∩~¬⊃D$%\jε.∃¬~VJ∃¬:∃α"
2∃αε"α2⊗ε≥!αR↑zαR"&t:L4(Jα*JN"α∩ε~t*H4(LB2Ji¬"Q1"∩H4(&≤Z>RQ¬"Q22_h(%αU∩NQα$*→N0hP&"2∃QαεI∀ 1" HH%n6
J
∃αD
M↓→∧Z⊗eα<zJ∩Mxh*∩⊗3~ h&DbJiα a"εI∀ $4(LRV6B*αQ2∩,1N`$KZ:&1ε#?↔Or;QβK/ W'K*α∩ε~,q→↓¬λh(&N\zRQα"bNd4PIα*J≥!α∩⊗3 $%n∧
RR⊗∀qα6ε$~"&:=→αJ⊗
*&J∃∧"⊗~Vr04(ε≤
&1α"bE⊗>¬"&>: `%n.-J↑>J%→αJ⊗
*&J∃∧"⊗~Vr04(¬αα∞ε&d)αQ2
*JNR0Im~>¬"&>: a1↓~∀*NQ1α2εVab↓~J⊗≥"Y1↓5∩⊗NR`h(%↓α↓α∞εLλ4(%α↓↓↓↓∧RJNQ∧"⊗→PhR∩ε→≥Ah&"∃∩iαε∪∩¬1"
⊃J¬$hP&*Vmα9αε∪∩¬2∩,1Nλ4T"⊗→NcP&6>4*%α¬e
2ε6∀"∧$%\~J⊗ε$)αε9∧
BBJ⎇αJ&ε$)α2εl∩∩¬6-BBJ⊗≥~&>8hP&BV≤B)αAd~>*LhP&6>4*%α
bB¬$4PJ"JJRα¬1ααH$%n$B∃α∞
⊃α>→¬""&M∧JM↓r≥α⊗
xhP&6>4*%αε⊃∩¬2FEαJ"N@h(&*≥↓αQ2$2BIHHIf∞α,~-αRzαN⊗∃∧J→αε$z5↓"≤Z&BM¬*:2⊗≥→αNfl∩>1$hP%α*∃~Qα∩,1N∧∀PJ6>Z,iα 1E↓$$%]~εJ∃¬""&M∧2V::Jα2&N h(&∞ J1αε∪ 2F6 ~J<4PIα*J≥!α∩⊗4r⊗H$KZ~V:uIα~>∀jεQα r⊃α6 ~J=α4bε≥α$z1∞Q∧j&`4PJ"JJRα 1"∩H$%n∧*∞F2L
Iα~⎇∩6εQR↓":εl)α⊗B¬∩:ε6*↓999Hh(&"e∩iαε∪ 1" Hh(&*,jB∃α
⊃E"∩,2:εHhP&"J∃Qα 1D⊃$4(M~⊗Rtλ∃∪∀∃A⊂K\iz"∧
∧ )I4u⊗λ*ibPλ ¬XPR-HASH" FOR EPPR-HASH PROPERTY,
∪∃U≠!
AλY Mα∩∩v↓↓+(A5+'(A¬→'∞A1∨↔εA%≤AαA⊃∪
I ⊂~Q¬α2ε∞(h(&"∃∩`∩∧%E∧αHβ"B)*34⊃$λK⊃⊃(f"".f53∩4jJh⊃∪iDuλ∃*8(⊃6
K2⊂*9λ⊃Q(~∃0Q!Q@∧d&∀-⊂ i V∀!
D@ ;4-HISTS UCE THE FOUBTH ITEM
;EXPR-HASH PROP NAIE IN AR∩A, OR -1;
; DEFINITIKF IN C; PROPERTY NAIE IN AR⊃8εA
β5
Aβ≤↓∞εI∧z→↓ααI0$*$*→N¬PJN.&∧qαZ∩,2V(∧KZR"∃¬2ε2V*α>→α$*~V9∧~> 5J)te_Q!∩∧U*:B∧$XfPHK4
DD(⊃6
K2⊂*9λ∩⊂(9c"B) ∀VHλ∃⊂
∀¬⊃"B2JY4⊃q$λ4LP%H⊃1MA↔rU3*∧∃3SλZth EY∩4u∧λStS(~β"B)YuQ2$λK
⊂*&*""'954u∧λq5λ
h3∃1$ qH⊃+ 4u∩)hh∀∀IZ⊃4U ⊃"B4
Zr∩H
¬⊃q5ε⊃".hλ→Qλ∀hX4Pr∧ 5λ⊃IzH⊂
$⊃P"l(∀⊗d iR⊂()'T"i*,CE JUMPE A,DEF5 ;IF NONE, DOSE
JSP T,STENT
TLLN DT,SY 9NO EXPR-HASH IF NOT A CYMBOL
JRST DEF5
MKVEI AR2A,QX@RHS@
;A HAS THE ATOM CONTAINING THE EXPR-HASH PROPERTY, IF ANY.
9AR2A HAS AJ ACTUAL EXPR
HASHPROPERTY NAIE.
DEF6: MOVEI B,(AR2A)
MOREI AR2A,(A) 8π'β-∀Aβ)∨4A∪≥-=→- λ4∀∪!+M⊃∀A 1∂ (b$∩w∂ PA 1↓H[⊃β' A!%∨A %)24∀∪∃+5!
Aα1 β J$∩w ≡↓ β
8A∪ A9∨≥
~(∪≠∨-∀A XQ∧R∩∩w∃1!$[!β'⊂AA%∨! I)2A-¬→+
A )) HA¬
A→∪1≥,i∧4(MαVN"Rα~bAe~εYVkλ4(εlzP∀,∀λ∩bD5⊃⊂K\8→d|t_8∀b∧H→T∀$∀λd⎇∀QQ M¬Z9∧R¬¬J5DD~9α[λ↔9d≤ IDβ
BhjTt≥I→tr¬9 ∧
≤↓Q M¬Z9∧R∧i
αe∃:BTkλQ!∀833H
J ⊃C!!(∩TJ:λ⊃⊃(g"".h→⊂(( λ4r⊃*4∪05λ→λ(⊃IzQq5∧ 5 C!!33uHY(⊂+¬λ4LP%⊃".rλ~r⊃4d 05⊂i¬λ∀sdλS∃4i∧∃∩⊃$λ6∀∀EY⊂4r∧
∀StλZU⊗#!!4∃4i H∀
(34∀Izα".dλ3Qλ
I⊃3H
λ4QSj)(∃∩λT⊃⊃1I→R5∩)YC"NjI⊃(⊂h~H∪qD¬∀
( ~h∃∩λT⊂5∪iT∃∪h
5∀∀Izλ∪sJInh⊂*&(∩4d
∩⊃(
St⊃**⊗(∪H→1.hλ4∩4h
I⊃(∃H→∃1+AQQ⊃1FWB2∪
+H⊂+λ¬∀
#!!16⊂i∧⊂k⊂*&#"B)YuQ2$λK
⊂e⊃"B2J*uλ⊃λXL""'8sh⊃ t∃∩⊃$
∃5∀
)tβ"AQQ⊃1FGB4∪j (∀ ε⊃"B4 zλ∀ λ!"B3)zQ2(λ∃∀)1λXU3B!↔hQ⊃(j3IHAQB4∃*9∩H∀¬HssTa⊃.q∀K∀⊂1p)→H∃r*Iλ
⊃λXU3Hλish EeJ(∀HZ∪⊂0hXλ⊂V!Q@2TJ:λ⊃5F↓".h∧¬⊃⊃1JYIH⊃Iyh KEe#"C! ↓A"Tu(*∃∪α*K24⊃(Yh⊃U)hu∩3ia"C"AQU⊗2*λ12nA⊃".s
:0TH¬ελ Hε5(∪Ph→∪⊂0IH#"B*9r4⊂$λK⊂qI≠ #"A∀∪3uHY(⊃Kλ:∪t∩AQB33jh2(⊃¬J5⊗2*λ12c!!0p3(x(∃β λk,c!!(∩TJ:λ∃sH→∪tq!QB4ri~⊃(∃↓⊃".sIt⊂4Qj4∂∂/D sQ(λ~Qh∪hd∪R3↓QB(⊂)zp(∃↓⊃".q)Jq(⊃λXtQ3(YUλ⊂*(h⊂sjYUλ⊃IzH∩3H83∪β!!(λ∀
Zrλ∀¬JMlβ!!33uHY(⊃ ¬
#"A_1⊃∩$λ
∃¬⊃"B3)zQ2(λ~LP+λ:∪t∩AQB16λ9λ⊂4F(+
⊃¬⊃"B2J:λ⊃ 3Pp)Iα".j
Spq*:h⊂4Hzh Hλ→Qλ aQTqP$Q(λλ
~⊗24λX2b"'4
⊂3
9h∀∃*9⊃4hλd∪sU t∀
#!*qP)↓≠tskJI4 U ∀5 →4⊃1)1"B4
Zrλ⊃K
⊂QJ
Q∀β!!33uJ9(⊂+
∀5⊗2!QB33jh3(⊂%HQT∀HJβ"B)YuQ2$λ+
⊂*&P*"!↔qq5∧λ4Qhε∀∩3@λ⊃"B2J:λ∃ λz∀Q∃λ!".qhZλ∀Q(_∃⊂0IH(∩3Dλ4LP!QB2U)Z∪H⊂%J⊗4∩f⊃".sI→λ∂/Dλ0pq*
λ⊂3K∀⊂r⊂*!"B(
4r∩D
∀λX2c"A∀∩TTjD∃⊗4 ;β"U ~∩l.A_p21$λ+∃∀JZ∩α"':λ∂/D
q04H→λ⊃Sj$∀Q0(H4H∀jH4Uβ!!(∩TJ:λ∃⊗* lb"'4⊂r⊂*(0u⊃*$
⊃+HuH∀⊂*(3Kλ X0pSe⊃"U⊗* l0nA~∃4r $∀ ∧J⊃12a⊃.p⊃(Yh⊂5∧λ(⊂rλ~C"B)*34∪∧
∃ ∃ ~∩n0!⊃.r∩*D⊃3qD¬(⊃⊂)8(⊂(∧
sqU∧$⊃3qED∀Q5
ZSH &⊃"B3)zQ(∃¬H∃∃∀h~J⊂4F(*".jλ12h
85∀h
Zλ⊂4F(#"B*I⊂h∃¬F
↓∃Tq1$
v3Uλ≠β"B*I⊂q(
E
ε↓"B( *Tuλ
K4∩l(a"B4
Zrλ∀¬Jβ"B*
4r∩D
⊂∃ →303AQB4∪j∧∀ ∃↓Q@0p)I⊃H ¬E∃
"!↔r∩5∧λ(∩∪j*R0SλT∀t∪ _r3Qd 00tIq"B2J:λ∃ λz∀Q∃λ!".tL\Y=_m∧≥~→$∞Y89∧∞_8[ UHλ∃.<<H⊂m|→(_mMxXY..c"B!⊃".p*&P+λ ≥Yλ≠,∨(~_.l(∀q*J99
(01∃λ_S⊃#!!ACK AND TRY AGAIN¬
$$PEEK: HRRZ TT,TYIMAN ;CALL TYIMAN ONE EARLY TO
JRST -1(TT) ; SPECIFY PEEKING
TYPK1F: TLNE T,266217 .SEE SYNTAX ;READER START CHARS
JRST TYPKX
TYPK1H: PUSHJ P,@TYIMAN ;CHAR NOT ACCEPTABLE - GOBBLE IT
JRST TYPK1C ;NOW GO TRY AGAIN
TYPK3: JSP T,FXNV1 ;ARG MUST BE FIXNUM
JUMPL TT,TYPK3C ;ARG BETWEEN 0 AND 777 =>
CAIG TT,777 ; SCAN FOR THAT CHARACTER;
TLOA TT,400000 ; OTHERWISE IS A SYNTAX, LSH'ED
TYPK3C: LSH TT,-⊃1 ; LEFT BY 1⊃, TO SERVE AS MASK
PUSH FXP,TT
TYPK4: PUSHJ P,$$PEEK ;@EEK AT A CHAR
JUMPL TT,TYPK9 ;SOFT EOF - GO REDURN -1 OR WHATEVER
SKIPL D _Q→1 R∩$w'↔∪@A∪ AM! π∪→∪εAπ!β%βπQ $~∀$A∃%'PA)3!,l~∀∪
β∪≤AQ(XQλ$∩∩wπ=≠!β%∀A)≡A=≥∃ααxR∧≤zAPPJ *%≥"
K∃∧]
A⊂K]8Z∧-∩λy∀ph*K∃∧[U!∃¬-9 "¬αH
ELLX→`HK9iu"¬IλR∧|hTαj∧yx$∀dTλ∀t"
(U%∃⊃Q LU*:B¬%~ 3 h!Q%%M 6cPL J%R¬EH¬%%8~"D
&(∩HJj8T*¬;→e$
↓Q M$Iib¬"HA⊂K\9λT Z
;∀u$≠∧∧ <→→e≥" X∃≤XQ!∩∧U*:B¬%~ 3(h*K∃∧]
G M∧z∧∧5E¬J@hUK~∧]C!~∧⎇αλk¬αd(j¬∀%↓⊃∪\- ~@hP~ u∧R
¬@hPQ!PU%~ 3KP~ u∧Jλk¬αc!⊃∪\4JZ4Bα((e¬∀J∧"∧ hDα∃"!Q%%M 7∀ P~94M∧dλT|5*I`HK4*4|5D$∧,|edα∧$xZ2∧tzD∧Luiy4(h!∀∧U∃:D∧k
JJ∧PH↔4¬$DTλT|4ieB∧∃ZD¬<LID¬∧L94¬-Q!∀U∃:D∧,|g⊃⊂KZ
I∧*∧Yxe4 D ∀2∧hX4-≥8~%JpQ!PP`H*:T∃%IA∃
,~EB¬4→J$-"Dλ∀t"
:U≥∧YhB∧5Yh5$Lyj0hPQ*∃,MG!∀l⎇hY∩∧"J~∃,MA⊃∪Le:X%∩αε∧αrβ∃⊃PPL→y$b¬EJ3
<h→D⎇≤QQ M≤9~∧*¬AQ J¬HK$
∧∃H⊂HK9ir∧
(tβkr
Z4*∧i→@hP∀∧¬∧⎇∧
αdλQ)∃"*↓→%∃≥D
de∃F1PTLid∧M%5K0hP_8∀Lrλ∃E%∃ZIHK8D∧l,→j2∧\→IB∧
4
∃,LZIEJ∧~4¬∧⎇:9∀∀dQQ J∧**5"¬iJ%#_Q!∀l⎇hY∩∧"F⊗cββε↓⊂K]h→dLdH∃T4d~iu∀,D 4LdAQ L≤→→b∧
J∀D-∃)z HK8Z%∀⎇$ T, j4¬<*
9∧⎇,HD∧\LID∧Lu
ZB∧∃Xhd-⊂Q!∩¬%+$∧"c⊗εβββ↓Q LlzhTJ¬JEBD
⊃Q Le9¬%"EZ4,<IxphP→Yu4*
JBe≥E
E"HQ!∃$dhT¬%"HkhP∀ T⎇4TλBbD∃⊃⊂K\i≠∧u,Tλ∃∀:πSb¬-8T∧4⎇$¬d∃∀X→2β eD∧
∀qQ LU*:B¬4J*C≤λQ+PK\YhB∧|d ∀4r ~E_h!Q hUh→E∀-G!∀U,ZλR¬"JiE∃#⊃⊃∪\e:X%∩αε∧αrβ∃⊃PPL*:α¬%EIE<T_90hP∀∧α∧d⊗ε∩be~h∀e∀XAPPM zα¬αH⊃PPM
Z4DR
¬E4 J:E⊂h&⊗α(M8ZD|J
8∃=≥↓Q M¬Z9∧R¬¬J$-¬h→@HK8h∀e∀ZD¬≥%)→d:∧yd∧5E∧ ∀r∧~
¬∀⎇
)∀
$T T thZ hS⊗∧PM≤XK$j¬8~u≥Q!∃∧⎇ $¬α`Q!PPh'73Z¬H→4*¬;→T∀|D u∩∧i≠∧u,T ∀r∧∃D¬¬-9∧¬∧t→XR¬≥J)∀t: z"¬4→JT*∧yjDj∧k
αph'73J∧y`¬$⎇∧ t2¬Iλ∃"bλ~2∧d~:B∧5
∧¬≤dzEB¬¬X9α∧⎇)_tLt→D¬4 JXR∧|dλeEαaQ hUh→E≥%'!∀U≥∧
Bdd~IthH↔:5%∀→hr∧
;∀l∀yGphP∀ %∃≥D
d e4⊃PTMDA∃≤-K)R¬4→HdM@⊃↔44d_t¬$D~D¬$ J(U"αz:E∀Lhtr∧M4 d⎇"λ∀∧4M jThh!~¬-≤ $¬αe ht- Q!∀l⎇hT¬∩dk
hUiJ%#∪!→∧e∃$λ"bD∃⊃PPM
Z4B∧k
αbD%⊃PPL
*%R∧∃E∧
HQ!∀U,Z b∧
JiE∃#!Q M¬Z9∧r∧k
αcλ⊃↔5¬-9∧∧
¬(Z$z¬yz$"∧iz"∧<yxB∧lX~5-∀QQ M¬Z9α∧5
¬E⊂h!~∧⎇∧$
α`h*h∀e≠↔!PTLid∧M¬5K0hP~94⎇%Dλ∩d5↓⊃∪L IIu:∧∀λdMDhYPhP∀ %∃≥D
d dZ* HK8Z%∀⎇$¬Rj¬zH⊂hP~8U$|T
d di≠HK8(T dK∀∧
∧i≠∧u,QQ LlzhR¬∩Hk¬H↔:4
4Tλ∩∧≤z ∩∧|dλeEQ!∃¬-9∧5E¬E∧
H⊃↔5¬-9∧¬$DTλdMDhYPhP~
U≤Bλk¬αe!⊃∪]∧λYb¬¬X9α¬$λT∧|dDλeEQ!∃∧⎇ $¬α`Q+PHK8Yd"∧_ib∧MJ1PU4→HU∃∪!Q$MαA~u$
1R∧
(t¬$zλ(R¬4→J$-αxXB∧mX:B∧∀Tλ∩∧4≠ e,j z"∧
;∀l∀yD∃hh)~B(MzH∩¬ZTλ∃∀:
Ir∧∀T
d e(ZB<,D U-≥Dλ$*∧∀
5Ll)yB
j↓Q LU*:B¬4→J5%⊂Q `HαNfgP iiUdbP+⊂f)`∀R HAS PUSHED A VAHRET STRILG ONTO FXP.¬
;9; VALRETTHATSTRING INTHE APPROPRIATE MACHINE-DEPENDENT WAY,
9;; EXCEPT THAT CERTAIN "IPS" STRINGS ARE ANTERPBETED IN ANY
3+≠ IMPLEH ≥Qβ)β∨8@Qβ≤↓β∃βπ!%∨≥∪M~A
∨HAπ∨≠Aβ)∪¬%→∪)2↓∨⊂~2JI8$)[Y`~∧_jD-∩λItLTt
tD
HZd-∩D
DD(⊂u
)3Qh ~h⊃S
Zr⊃1∧λTSs$λV∀ AQ@εE)⊃h∧VAL8
IFL ITS,[
SKIPN VALFIX ;WAS VALRET STRILG REALLY A FIXNUM?
JRST RETSTR ;NO, NORMAL HANDLING
HRRR TT,-1λFXP) ;YES, PICK UP THE FIXNEM
↓.BREAK16,(TT)
MOVE FXP,(FXP) ;RESET FXP
POPJ P, ;IF CONTINUIJG REPU@%8Aβ≥λ↓∂≡A∨8~∃% Q'!$t%:∩g 9λA∪
8A∪)&4∀∪≠∨Y
A$X!
1 R4∀∪≠∨Y
AλXDQ$R~(∪πβ≠∀AλY7¬'π∪∩↓8u↔∪1→9:~(∩Aπβ5≤AλYmβ'π∪$A8uW%YQ9:4∀∩@A
β∪α~(∩@@A)%'(AY→%(b4∀∪≠∨Y
AλXHQ$R~(∪πβ≠∀AλY7¬'π∪∩↓8A9:4∀∩Aπ¬≠≤Aλ10∞εN≤J%αphRrt∀PI↓α*∃~QαZe∩QL4PJ*JN"αZ2J#(4(∀U22JQ P&∞εlqα⊃2\
N∞&Jαplaubt4(Jα*JN"αZ2J#_4(&≤
6∃α"bnεN≤J%αpYZVrthP%α∞ j9α⊃eZεN∞LIαpL←*rt4PI↓α*∃~QαZe∩Qd4Ph)n"-∩∃α&~αR"∃∧jε∞"Lr∃6∩-α⊗:∩,rQαRDJ:≥α$yα∩=¬"=αJ-!αR"*αZε1¬~RJ&t84*Ze∩QUhhR&Q⊂JrZε2,)↓E"∩H4*&4qα⊃Eαbl4*≤ ∀&>-"NRIβ "I$hR&~9¬~ε&1eX4(&≤*Riα"`$$%\!α&M¬R⊗J=∧2>Iα%:=α∩L2~⊗J,rQαJ,
N>:~λ4(&lzZ⊗%¬"Q1EE⊃$$%]""&M¬α&⊗∞*α>→α≥∩εAαdz>.M∧b&.∀hP&"JdIαRQc!QA]β$%m¬~>6⊗$B&:≥¬∩B≥α<zV2⊃¬:J&R*↓"
V"α≡2M∧"&⊃$hP&&2$⊃αQ2% 4(&U*6B9¬!195λh(&6⎇2⊗%α bz4$KZ∞JV5"eαN%∩εeαtiα6ε\*MαB$b6ε⊃∧BεBBL*H4(L"B α bRP4PJ&∩B∩α⊃2R H%nRD*9αR-∩6&:
"∃α↑M"!α¬∧rV20hP&"JdIαI1#!A]Ah(&"∃∩%αIc "I$hP&BRdzε⊃α H%n2|
⊃αRD)αNR∀J:≥αLrR=α$B∃α∩Lr∃α⊗$JR>HhRt$%\*:⊃α|1α&~rαNε&`h*t$KZ⊗*⊃∧z→α&4qα⊃Eh*&~rα⊃IAeX4(&¬*N!ααb∧4(LBJJ%β 1E"∩H4(&$b=↓Ec!QA]β4(&≤Z&B∃¬"⊗:⊗E4(¬∧RJNQ¬X&6>4)αQ1λh($&lzZ⊗%β 1:B∀J&)hP$&∞4J
λ4PH&&2$⊃↓I2 h($&U*6B∃β⊃2Z2∃!R`4PH&NRHh($&U∩NQ↓riMαthP&JN≤
8$$K[OSW61βO?n)β∂#∂∪Eβ'w#=βSF)αJN≤
9β ,3⊂$(Jα*~∞`h(&6⎇2⊗%↓λa2JNLr$$¬↑k?[∃ε∪W≠→πβSIβ⊗ ∂-β&yβ?KN;'84PJJN∞ p4(¬∧R~∞0hRZ2J#2ah&D
2R_hP&B>ααA2∧hRt$%\*2⊃α|1α&~rα⊃I@hP&6>4)α~bαa"~BαH4(&∧zB)αα`4(4Ph*Z2∃!Mh4TJ~∃αM"M2lhRZ2J#Ih$4S A↓L*b&Qβ 04)∪↓⊂&" bR_4PJB>BRαA04Uh%n⊗t!α&~*α&BLhR&~9∧JRM2Xh(&6⎇2⊗%α"aEIAβ↓@$%Z∩N&2,rQα.Lb1λ∀U22JQ≤ h%:dz≡.V ↓E0$KZRJE¬"=α∩|9α>V h(&*≥↓αQ2≤J∩αRh(%:4
2V∀hP%:
∀*ε-↓ 11"⊃Hh($*4bJQePI↓:2|:>FQβ↓0$%]"Jeα$yα2≡8∧∧m-D ∀2∧it∧$¬Dλ∃4 →H∀∀dT↓PPJjh∀e,T 4
≤9≠"¬c*i2¬eQ↔4|BD
t,DEebph!~∧⎇∧$
α`H⊃↔4LRλ8∃≤* Iu≤-$λD|-4∧Eα∧j)tj∧~APPH*9∀$∃∀∞A∃Tu4hZλ⊗kJ)t∃∩)YK ∃
K#"B*I∪S@
J ∪t
HTRb!↔trr*∧∩1H )pH∩)hβ"`∩IMR DO DDT
JRST (T) ; (ACDUALLY, IF SUPERIOR HANDLES .BREAK)
JRST 1(T)
U ;END OF IFN ITS
¬
∃'U'! ≥⊂t∩∩∩m→'+¬H@P`@8@dR~(∪∃' ↓)(I→]→βπ⊗4∀∩@@↓→α`bHXY#'U'! ≥⊂~∃∪(⊂∪' i~A!-∩∩εXHI`≤
::Tl* ir∧¬YZ∧L@Qc"A~∃4r∧λS∀
&lα"'`iajSbP#bH i"P∀"j*i∪αINGFROM↓αA% M)β%(4⊂∪! M⊂A
→@Y$n`$∩wβ→M_
αε≥~V ,TλdM∃:@λλ~Qh∩*4⊂π'g g$fεB∧e*fT P",SUSP0
∪β=∃∃α ¬E≥
:ε∧λH↔9%,M∧ ∀2∧yhR∧
(qP@M zα¬αH⊃⊂HK4∧SHD⊂4QeD⊂1Hλ→T∧V⊂∩iP!`U P#$S"P' SbP#'T⊂ $iQcFE∧BD@]P⊃'i⊂$U)P IS FAME @∨ ↓!∩Vm↓α~&d)4)_db∧ ~4,<XYe"e1Q M≤9~∧r¬8¬4hi∀c"A→TTu∧
u0tελc"B*
4r∩D
⊃R)FPUα!↔pssJH4Uλi3⊃4jλ0h∩)DF ;MERGE WITH DEFAULTS
POP FXP,SGAEXT ;UNSTACK ARGS INTO PROPER SPOT
POP FXP,SGANAM
POP FXP,SGAPPN
POP FXP,SGADEV
PUSHJ P,SAVHGH ;CAVE HIGH SEGMENT
↓ FAC [FAILED TO SAVE HIGH SEGMENT - SUSPEND!]
] ;END OF IFN HISEGMENT
IFN IPS,[
PUSHJ P,FIL6BT ;CONVERT FILESPEC IN A TO SIXBIT ONFXP
PUSHJ P,DMRGF ;MERGE WITH DEFAULTS
POP FXP,PURFN2 ;UNSTACK ARGS INTO PROPER SPOT
POP FXP,PURFN1
POP FXP,PURSNM
POP FXP,PURDEV
] ;END IFN ITS
SUSP0C: POP P,A ;POP FIRST ARGUMENT
SKIPN A ;FIRST ARG LIL?
AOSA (FLP) 9YES, NO VALRET STRILG
PUSHJ P,VALSTR ;NO, PROCESS IP ONTO FXP
SKIPA
SUSP0: PUSH FXP,R70 ;ZERO WORD MEANS VALRET STRIJG
SETZ A,
MOVEI T,LCHNTB
SUSP11: SOJE T,SUSP12
SKIPE B,CHNTB(T)
CAMN B,V%TYI
JRST SUSP11
CAMN B,V%TYO
JRST SUSP11
MOVE TT,TTSAR(B) ;IF FILE IS CLOSED THEJ IGNORE IT
TLNN TT,TTS.CL
PUSHJ P,XCONS
JRST SUSP1⊃
SUSP12: JUMPN A,SUSPE
HRRZ A,V%TYI ;CDOSE THE TTYS LAST, SO THEY WONT CAUSE
MOVE TT,TTSAR(A) ;SPURIKUS "CANT SUSPEND -I/G IN PROGRESS"
TLNN TT,TTS.CL
PESHJ P,$CLOSE
HRRZ A,V%TYO
MOVE TT,TTSAR(A)
TLNN TT,TTS.CL
PUCHJ P,$CLOSE
SUSP12 HRROS NOQUIT
MOVEM LIL,GCNASV+1
MOVE T,[FREEAC,,GCNASV+2]
↓BLT T,GCJASV+2+17-FREEAC
SETOM NOPFLS
IFN ITS*USELESS,[
MOVE T,IMASK
TRNN T,%PIMAR
JRST SUCP14
,SUSET [.RMARA ,SAVMARU
.SUSET [.SMARA,,R70]
SUSP14:
U 9END OF IFL ITS*USELESS
∀~)∪
≤A%)'9λH`Y6~)∪(H∪M )>hαNε↑≥$%nM"Mαεe:εfM¬:ε:R~αR=α$yα¬α∧jεAα5∩> *λi∀d(β"B)YuQ2$
⊃S
:u⊂4JJ4β"A_4⊂r∧
∪∩*:∀uc!!33uHY(∃βλxsP4ja"LL∧A2⊂TK∧∃ ⊃)j∃Q0a⊃.pq*D∃∩⊃$∧PssJI3Q1$$⊂1⊃
(4th
Ih∀uλ~U 5*↓ LL∧A2∀TIT∃ ⊃)j∃Q0e6#"B*9r4⊃$
u0qIJb".i_H⊃S
Zr∩3Ht∀⊂
i⊃P( cQiP()∪abiiH+ f)⊃h⊂*$⊃gαE∧H%))jλ#&)f∀hεE#∪)g'j∞∧fgk⊃dP*,SUSP3 ;FROH
A⊃∃%αA∨8A∪≤AM)β%(↓β(A'U' fA⊃∪% πQ→2~∀%≠↔- 4A(I→%'!'.4∀∪!+M⊃∀A 1!∩Vmα0$%]αVJ∃∧"V6A∧b&NA∧J→αε¬αJ>B∀JεR∀hP&N.Mα∃↓λiEαH⊃↔4dLD $≤CqQ J∧**5"¬:Z4≤|a⊃∪@;14k∧λqsU →U1( yH⊂3HD∀Q5
ZSH∃↓QB4ri~∪H %E⊃R∀¬⊃".vHZSh∃iZQλ∪(X3Th ih∃P)JQ1⊂∀h)$g⊃FE∧P∩))j∀jih→
εA$j ∧h*iR%⊂(⊗∀"j+ SεE→_ ∧d!)∪dP_@,1(1)
λ JRST SUSP25
] ;END GF IFN ITS\D∩0 α
IFN D10,[
HBRX∧A(X9∃¬'αλ~∀&E∩1αQbr*
J,qλ$(Lj>J⊗hαQ2≡≤rεNXhP&6>4)αQ1tRαJ⊗`H%n≡-!α"ε<B⊗NQ∧
∩Iα<)α:⊗,!αR≥¬~εZ∀hP&"JdiαQEi$*p""'`g"∀j'i"H$g⊂!Si)"aU⊂(& PbiP)SP
ONITGR KNOWS
∪≠=) ~APX]∃¬→ ~∀∪5∨% ∩↓(Y'+M f~∃!&J∪⊃I%~A(αa0∀T*8⊂hT
4@LE*)R¬"J(U$Dy↓PPM99∃∧(
⊃IJ
""'g$f⊂∩!f∨FB∧P%)∀j⊂)jTagg∧B]lbiK⊂!gg∃$g*bH g"⊂∀"j*i∪⊂*εEαiedh∪⊂∀#,∀∀FE∧H%))jλ)jah ~εE)PR∧h*Td!⊂( )"`∀VAL ;PTLOAD VALRET STRING FOR SAIL
SA$ SETZM VEJOBNUM
JRST SUSP25
] ↓;EN@ OF IFN D10
SUSP24: MOVE T,FXP
POPI T 1
MOREM T,(FXP)
10$ MOVEI TT,
20$ HRROI 1,FLSPA1
IT$ MOVEI TT,FLSPA1
SUSP25:
IFN ITS,[
.VALUE (TT) ;PRINT SUCPENSION MESSAGE
JRST SUSCON
] ;END OF IFN ITS
IFN D20,[
PSOUT
HALTF
] ;END OF IFN D20
IFN D10,[
OUTSTR (TT)
HS$ JRST KILHGH
IFE HISEGMENT,[
IFN SAIL$[
MOVEI A,FAKDDT ;FOO, HOW MANY WAYS CAN SAIL LOSE?
SKIPN .JBDDT ; JOB@DT MUST BE NON-ZERO TO SAVE!
SETDDT A, ; ELSE MAY FAIL TO SAVE EJTIRE LOSEG
] ;END IFN SAIL
EXIT 1,
] ;END IFE HISEGMENT
] ;END OF IFN D10
SUBTTL HIGH SEGMENT SAVE ROUTINE
IFN D10,[
;;; THE RELEVANT FILE NAMES ARE IN SGADEV, SGAPPN, SGAEXT∞
;;; THE MAIN FILE NAME IS PASSED THROUGH T, AND STORED INTO
;;; SGANAM ON SUCCESS. SKIP RETURN ON SUCCESS.
IFN HISEGMENT,[
SAVHGH: LOCKI ;LOCK OUT INTERRUPTS AROUND USE OF TEMP CHANNEL
MOVE F,SGANAM
IFN SAIL,[
SKIPL .JBHRL ;IS HISEG CURRENTLY WRITE-PROTECTED?
↓ JRST SAPWIN ;NO, MUST PRETIOUSLY HAVE UNPURIFIED IT
SKIPN PSGNAM
JRST FASLUH
α MOVEI T,.IODMP
MOVE TT,PSGDEV
SETZ D,
OPEN TMPC,T ;OPEN UP .SHR FILE DEVICE IN DUMP MODE
JRST FASLUH
MOVE T,PSGNAM
MOVE TT,PSGEXT
SETZ D,
MOVE R,PSGPPF
LOOKUP TMPC,T
JRST FASLUR
MOVS T,R
MOVNS T ;T GETS LENGTH OF .SHR FILE
↓ADDI T,HSGORG-1
PUSHJ P,LDRIHS ;GO READ IN HIGH SEGMENT (FROM WITHIN LOSEG!)
RELEASE TMPC, ;FLUSH TEMP CHANNEL
MOVE T,D10NAM ;ESE D10NAM AS HISEG NAME TO FOIL SHARIJG
LSH T,-6 ;AS LONG AS WE'RE BEING RANDOM...
SETNM2 T,
JFCL
MOVE F,SGANAM ;RESTORE MAIN FIHE NAME
SAPWIN:
] ;END OF IFN SAIL
SETZM SGANAM
MOVE R,SGADEV
IFN SAIL,[
;;;SAVE VALIDATION WORDS IN HISEG, HOPE DHAT HISEG WRITEABLE
MOVEM R,PSGDEV
MOVA D,SGAEXT
MOREM D,PSGEXT
MOVE D,SGAPPN
MOVEM D,PSGPPN
] ;END OF IFN SAIL
MOREI D,.IODMP
MOVE T,F ;SGANAM WAS SAVED IN F
SETZ F,
OPEN TMPC,D
UNLKPOPJ
MOVE TT,SGAEXT
SETZ D,
MOVE R,SGAPPN¬
SA$ MOVAM T,PSGNAM
ENTER TMPC,T
UNLKPOPJ
MOVEI DT,HSGORG-1 ;H β↔∀A+ A%∨ ≡⊂hP&NV∩αRQ1tRα"J`h(&6⎇2NMα% 4(εE∩J%α%!2"N<zJ
5α⊃PPM8ZER∧EAPPLzZB¬$Zλ2e%A⊃∪\]XJ¬-"λI∧*∧α∩4hXc"B$λp20!Q@∧P⊂∃g&%h∪h%εEαab'iQP*&h⊂T∧D]Q&*adλ*"fhλ!d g∪"fεEαi"f"PibP*∪h!VεB∧fgk⊃dP*ε∀c`g SDD]kQP!`i⊃c*f&⊗P"'P∪'j⊂)U'i"P∀c`g SP*g*∩fεE∧Ug&'aRdDDDNP+bP∩ k"P⊂d"`i∪,P+gS⊂∀&gT P'iλ&"iiJFE∧e∀)j⊂(∪h%_FBεA.DNbg"⊂∩c'⊂$∩ibcfQe*εE↔DD]bS ⊂'cλ$c'⊃_XεEβEβ∧@
SUBTTL ARGS FUNCTIKF
ARGS:↓JSP TT LWNACK ;LSUBR (1 . 2) - USES A,B,C,T,TT,@$R F
LA12,,QARGS
∪∃M A$YA →αd!(Rα∩m'!% ¬λAβ%≥&~∃βI∂&bt%'↔∨)PAαY'd~∀&U∩NQα
∩≡M@HIf~&∃~Qαε∀9α6V≥!α
∃¬~f6
|`4(εDbJiα2a"¬$hRεJ≡≠
¬hε z*1α"bεJ≡≠_$%nαJtj∧~(u_h!→∧e∃$
"c
λe⊂HK9*U≥"
x∀u"
Ir∧<ZD¬¬∀X8Tu"λ~$=~
$mQ(∃∀=8:SPL*YU∧*
λh3∀q!⊃,p4Hzh⊂sijk54↓Q@∧db∩k$P) _X__βE∧ieRh'⊂! #εE∧R))j⊂⊂i#iaLFE∧fSi"dP∃*⊗⊗HJ#∀FEαe)h⊂∃⊗#$l `FE∧Sgk"dH!⊗∀ JFA i⊃iaX]αiedh∪⊂ V)βE JRST CONS
MKVEI TT,(R)
AAIE TT,777
SUBI TT,1
JSP T,FIX1A¬
JRST CKNC
ARGS3: JUMPE A,CPOPJ
JUMPN B,ARCS%
HLRZ R,1(B) 9JUST WANT TO FLUSH ARGS PROP
JUMPE R FALSE
SETZ R0~∀β!U'⊂A 1α~∀∪)' Aλ1β%∂π1∧∩∀∪M+∧A 1$n`VD~∀β∃I'(A)I+
~∀4∃β%∂Ljt∪!U'⊂A 1α~∀∪M )5∧↓)(Y$4∀∪⊃→I4AεX!∧R$KZ6V6∀b∃α6,j
2∃αiα6V≥!α~&=*J∀4PJ*V6∧)α
2
∩≡MXHI`~∧zZB¬<λ~D-∀X ¬<*
xU∀* λ∀t∧XAPPL*:α¬"Hk∧u31Q L≤→_R¬∩Fvs(h!_∀$$α(∀EF!"B)Jrλ∀EF,#"H~QtmG!2∀TK$⊂+
λ%!"B)*tλ∃¬HV∪UF⊃"B0h→1(∃
E
mmaQB01λI(⊃∃¬F#"B(_⊃∩(
%
∃∃¬⊃"B2 JTH∃
E *⊃E⊃".s yrh⊂*D⊂4Qj4∀⊂Sj∧⊂3∀HX1⊗(
I⊃4Q!Q@0p)→H⊃∃¬E∀J"!↔r1Hλ→∀Q0(K(⊃rλ~λ∃q$
p3U¬D∩U4jD⊃6∩*Eβ"B)*Tuλ
t⊂2A⊃,h∃ λ4Q0K∀⊂5Si_∩3Qdλ(∀∃*((⊂⊂(x(∃∀H~β"B)YARGCLB: MOTEI B,(F) ;CLOBBER IJ AN ARGS PROPERTY
ARGCL3:
PURTRAP ARGCL7,B, HRLM R,1(B) ;MAY HAVE TO FUSS ABOUT PURE PAGE TRAP
JRST (D)
ARGS0: MOVEI F,$$$NIL
JUMPE A,ARGS1A
WTA [ NON-SYMBOL - ARGS!]
JRST ARGS1
αSUBTTL EVALFRAME FUNCTIKN, GTPDLP, AND FRETURN
EVALFRAME:
SKIPA R,[GTPDLP] ;THIS ENTRY CAUSES ANTERPRETATION OF ARG AS PDLPOINTER
FRM2A: MOVEI R,GTPDL2 ;THIS ENTRY, TO ALLOW CONTINUING FROM WHERE D CURRENTLY IS
JSP R,(R)
$EVALFRAME ;GET EVALFRAME OR APPLYFRAME JUST PRIOR TO
$APPLYFRAME ; POINT ON PDL MARKED BY ARG
JRST FALSE
FRM3: SUB D,R70+1 ;DAFINE A FRAME POINTER TO BE JUST BELGW THE EVALFRAIE MARKER
HRRZ TT,(D)
JUMPN F,FRM3A ;F IS INDEP⊂A= A/⊃%π⊂A↔%≥λA∨_A
%β5
~∀∪5∨- ∩↓(XQ)PR~∀∪1'⊂A(0[' ∂1≠∞~∀%'↔∪!0A'(QPR~∀∪)%'(A→%~iα4∀∪⊃→I4A)(0Q)(R4∃¬%~Mαt∪π¬∪≤A PY#
¬→
%β5
∩g =≥(Aβ1→∨.AQ⊃αAπ¬→_A)<A -β1
%β≠∀~∀∪∃I'(A
I~e∧∩$rA∪)M → AQ≡A¬
↓≠+)!U(~∃
I~iαt%!+'⊂↓ XQλ$~∃
¬4ht∩∩$w %%→%β≠
↓π∨≠ LA⊃ %∀~∀β⊃1%≡A)PXQλR$w↔≥
↓→
(↓⊃β→ ≥&Aβ&↓∂∨∨λ↓β&Aβ9∨!⊃ H\\\~(∪∃' ↓(Y
∪`cα∩w5β↔
AU A!%∃)∪∨+LA'!
∪β_AA _A!=∪∃) H~∀∪!U'⊃∀A@Yβπ∨9&~∀∪∃1π⊂AλXQ R4∀∪≠∨Y
A)(0bQλR4∀∪πβ5
A)(12Iβ!A→3
%¬≠ :~(∪∃%'PA
%~`~∀∪!U'⊂A 1α~∀∪A+'⊂A@Y∧~∀%≠∨-
↓(XZd!λR@@9'
@⊃β!!→e
%β≠∀@∩w¬∃ββ+'∀A)⊃ I
A∪&↓αA ∪Mπ+''%≠≤~∀%∃+≠!0A(I
I~j∩∩$r@A∨_A)⊃
↓
%β≠∀A
∨%5β(A)! %
~(∪≠∨-∃∩AαX!(R~∀%)→π≤↓(XZb$∩∩w !∪≥⊗A¬¬∨+(↓)⊃∪&↓/⊃ ≤↓3↔*A1∨↔⊗B4∀∪∃%M(A
%4n~∀∪!→%&AP∩∩∩∩m'+¬)1
A/βdA)≡A≥ (A≥∃∂β)∪=≤∩∀∪¬ %¬!1"⊃Hh*~Jk)h&N-"iα¬`h*~Jk*¬h&E∩Jiα∩a"Q$hP&BV≤B)αAeB∞.:_h(&ε|∩*9α b~J5,λ4(ε¬*N")¬↓2:J-2⊗JN(h*~Jk9h&B-~")ααbε∞>u_4(&∧zAαAd⊂4(&¬*N")¬↓2b∞|rL4(Lj>Z⊗Jα 1"
H4(&∧zAαAdλ4*~∀iah&¬*N")¬↓2b∞|rL4(Lj>Z∃∧⊃2∧%\zVRB-!↓Q6dJNQiα↓↓
⊗4
1 α⎇⊃↓
ε¬α2e ∧zI↓
-∩I α\ αNfl∩>2thP&"J∀z%αR"a"⊃$KY↓α~∀
6∃↓E∩⊗≡B$a%αB|J:R⊗∩αn¬α4Jb:Vmh4(&U~AαQd2&aFλIm↓↓d2>J5rαn⊗Z buα>∩↓!r~sq↓rε∀:My%¬ZεBBeJt4(MαVN"RαA2∞|rL%lLzI↓rm~≥6~⎇∩5yα\*JJthP&6>4)αRQc "⊃$KY↓αεdJNQ↓E~B⊗∞∧"1%α∧z&:R-⊃αn¬∧2&b:,jt4(Lj>Z⊗Jα 2F|*Zε0hP&∞εlqαRQeY∩εB∧bf~J j⊗t4PJ6>Z,Iα 2
BB2Hh(&∞ j9αR"bm∩⊗∃∩~Jεl*t4(Lj>Z⊗Jα 2F-∩H4(MαVN"RαA2b≤z:L4PJ*JN"αB>B∀P4(4T2J5J∪P&R2t)αI1λh(&ε$!α⊃2∪9A-HKZ↑"⊗rαN⊗ε∀~"&::α~>J<
J⊃1¬~.&A∧zZ⊗I∧~ε20hP&*J≥!α~Jk∩∧%n$yα⊗Z b~Jεl(4(4Ph(4(hP4*≡%α∩2APH$%n≤
22⊗"α
eαU~AαId:RB∩e↓mαJ-"VJ:~αB∩1¬αRIαLqα⊂4PJ6>Z,Iα⊃1E↓$4(LRV6B*α¬2≡%α∩1HKZεJ≥lr&1↓kqαNR
∩QαN,
J∞!∧2J>5∧~VJJ,rQαB$aαB>_h(&*≥↓αQ25B:YDKZ:>R+Qα⊗Z b~Jεl)α2>|ZMαε"α
&Qβ→9Eα|1αH4PJ*V6∧aαRQd:RB∩c(%n
M!↓M9
α>→α∩↓u↓A¬:"⊗9¬~⊗εJ≤B&:≥∧∩ε∞-¬""∃α∧"04(M"2=α∩aD$%\∩&Q↓~qEα>2αI↓uβ α↑",qαN⊗
∩ε"&t9α~>∃:εJ⊂hP&6>4rMαR In↑εu!αR=¬~.&A∧zZ⊗I¬""∃α5∩ε6∃∧jεJ.-⊃α↑",p4(&≤Z&B9¬"P%m¬~⊗εJ≤B&:≥∧2>J↑
∩⊃↓"≤J:∞∃∧ αB∩eα>&:$*Iα↑Lb04(M~.&B
αRQ2≠⊂%mα∀)αB>LrR&::αR=α|r∃α
,b>]α
α~Jεl)α6ε∀Z⊗I$hP&ε∩"αRQ2∪9A-HhR≡RB$aUh&$biαR"a5D4PJ"JJRαQ2
⊂h(&∞ J≡∃α%!1"QHh(&*∃~Qα≡%α∩1DhP&6>4*%αQbBA$4PJNV
JαQ1"%!$4(LRV6Bd)αQ2="B∩1λh(&6⎇2⊗%α a"RQHh(&∞ J1αQbBA$4PJ6>Z*αRQ2h(&"∃∩>%α"a"RQHh*≡R∧"1IhLj>Z∃¬"Q1"⊂H%n.-Iα>9¬:"&∞BαR=α≤*εJ∞@h(&*,jB∃α%!1I"∩H%n6
"ε!↓α↓uyαtyαN⊗
∩∞!1∧RVNQ∧:&Z∃∧zVQα∧"1αB%⊂4(&lzZ∃α2aE"IHInN⊗da1α&":MαB⎇~N&
d)αR=¬~⊗εJ≤Aα~>∩αR↑=¬""&:=_4(&$b:∃α⊂aD4(LRJNQ∧:RB∩c 4(&E∩Jiα"b¬H4T:RB∩c→h&∞ J1αQbB⊃$%\ α
ε≤YαN⊗
∩∞ 4PJ*JN"↓I"IHIfN⊗
∩ε"⊗"jε:⊃l2ε&2,!α⊗bM 4(ε≤
69α%!1"⊃Hh(&*∃~Qα≡%αa@4PJεε6rα→1""H4(εU∩NQα="BaDhP&N>T α⊃2="B∩1_h(4*="B∩⊃#P&6>4*%αQbBA$∀T:RAR P&∞εlqαRQbB⊃$∀PJ*JN α≡RBC4(ε≤
69α2a"⊃$hP&*J≥!α≡R¬AD4(L~ε&≥¬!1"⊃Hh(&*∃~Q↓IE⊃$%n4
&2V∀(4(& z*¬α"b≡RA$λ4(4Ph*≡R¬AAh&$"j¬α2b_4*="BaEPJ6>Z,Iα→1λh(&*∃~Q↓ME⊃$4(0$(j$-∃0 '∞⊂⊂""⊗ P!V⊂DD]f∩⊂#c⊂⊂P)"fQda"i∀P+d$Pd⊂"g∃),FE⊃)"`∀RY:↓ MORSI C(TRUTH
HRR C,B¬
JSP R,CTPDLP
0
JFCL
↓MOTAI F,(D)
MOVE TT Y$EVALFRAME]¬
@πβ≠≤↓)(Xb! R
∀$A∃%'PA
% Q$b4PJ6>Z*αRQ2Z"εBBeJ~Jεl*t4(L~ε&∃¬"Q1ED1$4(Jα*JN ∧∧5∀X∧TAQQP "U)_]∧SdπVEI D$(F)
α SUBI D,(P)
HRLI D,(D)~∀%⊃%%∩↓λXQ $~∀β≠=)∃α%!2m∩,J~Jεl*t4λL~ε&∃¬"Q1" H%nN,
J∞↓∧2>Iαλ∧¬-≤Z ∧LUHZ%∃-
@∧5∀→XPhP∀λ∀l∀)`∧"beV⊂hPα0p)YH⊂
* ∀"∀FB∧P%)T⊂**ε∃da)%CE# ∩P1: SKIPE T,PA4 9BREAK U@ A DOMIJEERIH
∞AA%∨∞~(∩Aπβ%_A X!(R∩∩m7 ≡"L~!α
∀*ε.M¬*Aαεu"⊗J&⎇⊃α⊗J∃~⊗BM∧
:↓α≤
R∞"-~t4(J↓α*J≥!α~Jβ⊂4(εlzP∀ ∀
E"dh*β
k⊃⊃∪L4→8R∧⎇Z@λ
(5∃4ID⊂V( →β)bi∃$g#@⊂P)"j∃i'⊗`Q ∧RESS
MOP
~↓)(X[1!% VDQ(R∩m∨ A
I bA∨8A)⊃
↓! λ~(∪∃%'PA% %*J84Ph"
Jβ⊃h&N\JB¬α∩b⊗JJ$p$%N∃∩⊗ε-¬*Aα¬∧">6&t*⊗J&t9α⊗J∃~⊗P4T2JAJ Q↓↓α≤
&!α2a" $hP%↓αU∩NQα5∩AP4PJ6.Z,IαQ25∩AD∀PJ6.Z,IαRQd2JADhP&*J≥!α
.∃~Q@4Ph*
Jβ!h&N\JB¬α⊂b≤
J*D`H↔8%∀,→0λ
Zλ⊂(λ`j!dβEP!Pdf⊂# ∀!∀FB∧P⊂%∀)j⊂#∀(→FEαfgk"RP*⊗#∀(_DDNdg⊂!PibP'Q⊂*g+RdεD-PROTECT α MOREI TT$FRP1¬
JRST@KRST0 α
FRP3: SKIPN B,EOFRTN ;BREAK OUT GF ANQ E-O%F SET READS
λ JRST FRP3QA
CAIGE F,(B)
JRST F@%@eα
∃→% gβ∧t∪≠∨Y ∩Aα0QεR~)∪
AAβ∂∪≥≤Y6~∀%β ∩↓ Xb∩$w
∪0↓+ A!⊃_A!∨%≥) ¬L~∀β'U∧A Y d~∀∪!%→&A_~∀ββ⊃λA Y d~∀∪5∨%
A@Y
∀%⊃%%4↓ XZd! R4PJNV ∧12~B≠⊂4(εE∩2Mα0h(&ε$!α→25B¬H∀PJ6.Z*α~bAd04(εDbJiα2a5I"αH4(ε≥* α→d22
HhP&"Je→α_∀PJε∩⊃∧12~2≠⊂4(&lzZ*λiEαdaQ%hH↔8Tdα xb∧LhT¬∧ y→d8h)_dr¬λ_tLTuK0HH↔9∀b∧∀
∧ <X@¬≥M:HTjbλI∧*¬λID⎇H∩⊂)h∪⊃4AQ@2∀J)r(∀¬F*⊃J!⊃.h∃i→⊃λ⊃I≠λ∃4∧
∩⊃( I∀h∪hd∃∩⊃$
⊃∪λ
∀Tc!!2∪∀IT⊃S∀¬E,J∀¬⊃"B2
*Sh⊃K
→
(⊂FE∩c'⊂(⊃&!*cK-FE∧T!$l(⊃&⊂**βEc&∀!$l(⊃&⊂"*βEc,∀!$l(⊃&⊂**βE*D]Qe"⊂'Q⊂$c'λ("&!∃cFE.BD]bg⊃⊂'c⊂∩c'⊂(⊂c`g#CE HLRZ TT,-1(P)
TLNN C,-1 9FOR FRETURN" JUST UNBIND TO MARKED
α JRST UBD 9 POIJT, AND POP FRAME
PUSHJ P,UBD
HLRZ TT,(A) ;BUT DO MORE FOR "FRETRY", AFTER UBD
JSP T,%CADDR
POPI P,L$EVALFRAME ;GET RID OF BASIC EVALFRAME
CAIE TT,QAPPLY
↓ JRST ERAL
HRRZ B,(A)
HLRZ B,(B)
↓HLRZ A,(A)
HLRE T,(P) ;GET RID OF ARGS OJ APPLYFRAME
SKIPG T ;FIGURE OUT LEJGTH OF ARGS PART
MOVEI T,1
HRLI T,(T)
SUB P,T
JRST .APPLY
SUBTTL GETCHAR, GETCHARN, AND INTERNAL STRIJG FUNCDIOJS
$GETCHARL: PUSH P,CFIX1 ;@'U¬$@dZA≥π¬→→β¬1
~∀∪M↔∪!α↓ Y75A∨!∀X1π!∨!):~∃∂∃)π⊃βHp∪≠∨Y
A Ym
β→'∀XY%
⊂e:∩m'+¬$d~∀∪M↔∪!
↓,]%'∃(~∀∩↓∃%'(↓∂ )π p~∀∪M↔∪!∞↓λXQ∧$~∀αA)%'(A≥ )π⊂P~∀∪!U'⊃∀A@Y!≥∂P`~¬∂∃)π⊂bh∪'∨∃0AλXQ_R~∀∪% ∪-∩↓λY¬3Q'/λ∩lQ"Y$$A#+∨Q∪ ≥(1% ≠β%≥ $↓∪∀Aλ1$~∀∪M∨∃_A⊂Y∂ )
⊂f~∃≥ )π⊂Hp∪⊃%I4AαX!αR∩w
$A¬dA"A∂=% &~(∪'∨∃≥
AλY≥ )π⊂H∩w%
β→_AQ⊃β(@!π $A9∪_B@tA≥∪_4∀∪∃+5!
Aα1∂ )π h~∃∂∃)π⊂fh∪⊃→%hA)(X!αR~∀%→ ∧AQ(Y¬!¬%&Q$$~∀∪∃U≠!≤AQ(XQ $~∃∂ Qπ⊂ht%≠∨-&↓ Y ~(∪∃%'P@Q R4∀~∃∂∃)π⊂ph∪∃' ↓(Y
19,d~∀%!+'⊃(A Y!9∂ (~(∪∃+≠A∞AλY≥ )π⊂D~∀∪∃I'(A∂∃)π⊂h4∀~∀wQCEYJ↓←LAEeiJ[aQefXA%]i↑@ CeeCdDAEr↓S]ISIKGiS9NAiQIjAgCHA←LAM)$↑u¬%%β2~∃¬!¬$t∪%∃! β(jXApxfjZ\T]%!
≥(⎇>Ll|V`]>f`AQ)'β$-')$K¬$~∀wQCEYJ↓←LAEeiJ[aQefAM=dACEM←Yki∀ACIIIKgfX↓S]IK`OHAEdA)(~)¬!β%Lt∪% A β(@TX@xxLjZnT9%!π≥P⎇>flxV`o>L`@Q)PR~∀~(~∀K∪Mε]≤t%!+'⊂↓ Yπ
%0b∩∩$vW∪≥Q %≥β0[π⊃βH[≤~∀@A¬β-!%≡~(∪≠∨-∀AλXQλR∩∩∩m∪≥ `A∨ A⊃ '∪∂9β) λ↓π⊂~∀%∪ ∪-$AλXj4∀∪')I/ ≥≡↓)(Yα$∩∩w/=%λ[∪9 0[%≤[β%Iβ2A∨_A')%%≥∞A¬¬'
~∀$Aβ $A$Y¬Aβ%&[ !β$@$∩w+'∀A∨)⊃∃$A¬ ↓)β¬→∀A∪ AA+%
AM)%∪≥≤~∀∪β⊃ ∩A)PXQλR$∩∩w/=%λ[∪9 [%≤[')I∪≥∞A= A% E+ ')∃λAπ⊃¬$~∀∪1 ∧A)PY¬!βHQ$R∩$∩w∪≠A+%
AM)%∪≥≥&A⊃βY
A/∨Iλ[∪≥⊃ 0A∪9)≡~∀@@A≥=!%≡~(∪!∨!(A X∩$∩∩vAM)$↑uM)%∪≥≤[β%%¬2~∀~(K∪'$9≤t∪≠=-
A 0QεR∩$∩vW∪9) %≥¬_[%!1βπ⊃βH[≤~∀@A¬β-!%≡~(∪≠∨-∀AλXQλR∩∩∩m∪≥ `A∨ A⊃ '∪∂9β) λ↓β⊂~∀%∪ ∪-$AλXj4∀∪')I/ ≥≡↓)(Yα$∩∩w∂=%λ[∪9 0[%≤[β%Iβ2A∨_A')%%≥∞A¬¬'
~∀$Aβ $A$Y¬Aβ%&[ !β$@$∩w+π∀A∨)⊃∃$A¬ ↓)β¬→∀A∪ AA+%
AM)%∪≥≤~∀ββ⊃ ∩A)PXQλR$∩∩w∂=%λ[∪9 !lJ96N%∩&*≥∧z→α∩-~&≡:
"⊗⊃α≤@4(&%α α→d∩BεIE⊃$4)α↓↓α:⎇αJ<4PJB>BRαA04Ph)⊗&≥9:9hMαVN!¬↓2∞~MAD$$KY.&:$*J:εbjNRJLr≥6↑⎇∩⊃68hQ↓↓α∀
.BJxh(&N%∩↑∩:zαRQ2λH$%n<zJ⊃6Lr∩⊗AlJ96ε∃∩εeα|1αNR∀J:≥α∀
N∀4PIα*J≥!↓9- h(%↓∧
∩⊃α%!1" HH$%n<zJ⊃6Lr∩⊗AlJ96N%∩&:≥∧z→αJ-
V⊗N$*⊃α↑⎇∩⊂4(J↓α6>4)αRQdαRRN
⊃.NR∩*εH4PI↓αB⎇α)αA`h(&ε$!αRQbB $∀PJ6>Z*αRQ1E"Q$4R↓↓↓αtzBJ<hP&B>∧QαA0Hh(4),JNN]tqh&6⎇2∃αIbB
$$KY.&:$*J:εbjN⊗Qm~RJ&t96↑>∀!684R↓↓α
ZBJ<hP&NR∃:∩:=¬"Q2∧HH%n↑⎇∩⊃6&t"⊗a6Lq6εJ∀
eα>2αNRJLr≥α
~∀4(Jα*JN"↓9-PhP%↓α "⊃αR"a" $HH%n↑⎇∩⊃6&t"⊗a6Lq6NR∀J:≥α|1αJ⊗
*⊗NR,!α↑>∀ 4(¬αα6>Z,iαI2¬"RNε∩ZNRI,
H4(J↓αB>∧QαA0hP&ε∩ αRQ1D⊃$4(Lj>Z⊗jαI1"%!$4)α↓↓α:⎇αJ<4PJB>BRαA04Ph(4(0$
≥*
RRbαNV
dJL4(hRNV
dJMhεU*6B9∧ 2NV∀bN∧$KZ:V2bαNV
≥"&BV$J> 2 I∃≥#qQ LlzhR∧
H!⊂K]_Z2b¬(ZE-∀d
4,≤yhB∧
(qPPM z∧R¬¬APU≥X)E≤ !~¬-≤∧
αdλ⊃↔5-≤Z4∧ltK∀∧
d%JBe%EHBe⊂Q!∃¬-9∧¬αd!Q LlzhR∧"H⊃PPL ID⎇~ iu
,~A⊂K\Yx%J∧HYD
LXD¬
,~D∧4,~JU∀(Q*5,∀F↔ LUYZ∧*∧EJ5,∀F!PPL J%R¬EE∧"H⊃↔4
¬:X%≥$~JU$Ly`∧dM:D∧M~ I∀\(Q!∀De+$∧∩b
E⊂HK5¬¬+
¬d¬≠
∀¬¬+∩¬d¬≠∩∀¬bαr¬e⊂hP~94⎇%Dλ"e≥⊃Q LU*:B¬≥X)D⎇≤QQ%≥,)F∀∪P→
%∃Rλ∃BD∩⊃⊃∪M≤[
¬∀-:9∀|r
4∧M~
:T∃≥I~E-$X@∧4⎇$λ∃$|T
PhP→ E∃Rλ∃BD
⊃Q L≤→→b∧
J~5,∀I~0hP→*%≥"
:T∀c_⊃PPL
*%R∧∃E¬"HQ!∀l⎇hYR∧∩JAPPL
*%B∧%E∧∩HQ!∃¬-9 "¬αH9tu_Q!∀l⎇hY∩∧∩J~5,∀I~0HK8
U"α*:T∀d~4"¬¬)z∧-∃K∀∧|R
I∧⎇≤Tλ∃$|Z4¬*∧→`¬$DQQ M¬Z9∧R¬¬K∧≤\j1⊂K]:X%≥$~JU$Lyd∧dM:DαBEV⊂αr¬f⊃∩αr¬dαrα
Ybαr
ibJHQ!∀E∃)P∧
b
E⊂hU:X$c ↔!∀E∃+$∧"bλE⊂hP→Yu4*
EDLuHiD8h!_∀|TxT¬"e:X$cλ↔6βkr ir∧LjEBαk↔Wb¬-8Z"∧LjEBαk%ES≠kd
∃,MAQ LlzhR¬∩HAPPL**5"¬:X$c≥⊃Q hU:X$d⎇8W LUYZ∧*∧%J5,∀F; hP→Yu4,∀λ∩bD%⊃PPLYzd,J
!BD"⊃Q LlzhTJ¬EK4d-&4¬]≤≠λ$M" Id|rX~D|l_4∧M∧YTαj¬:X$dM4≠EmhQ!∀l]hYR¬"ER"Eα⊃Q%≥,)F5 P~:T∩¬¬J#;α6⊃PPL**5"¬:X$c≤⊃Q%≥,)F5SP→Yu4,∀λ"dt→J¬∀⎇
1PPL**5"¬:X$c !Q `H*:T∀c'!∃∧⎇∧
αdλQ!∃¬-9 "¬αJ8$cλQ!∀T49APPLYzd,J
!CK:(Tl⎇hT∧ dD∧%≥,)I∃~∩λ
$m∧Z*DL-1Q%≥,)F4 P→Yu4
λJBbE¬⊃PU≥X)C≠P_8∀Lr
%BE%E⊃∪]∀YYu4
∧*5,∀I~2∩¬
)u∧-*K⊂hP→*%≥"
:T∀cAQ LDJ+"¬"E
E"HQ!∀De+$¬"b
E⊂hP→*Tm∧d
Bbr6!PPLYzd,J
ADdLJ
$⎇¬1Q LE*+"∧∩E
BHh!→T⎇4Tλ"bD%⊃PPL J%R∧EH hP→
%∃Rλ%BD∩⊃Q L≤→→b∧"J~5,∀I~0hP→
%∀jλ%BE"⊃Q LE*+"¬%EE¬%"⊃Q LU*:B¬≥X)C_h*:T∀cG!∃≥,$
αe∪v¬3λh!→%∃≥Dλ5T 9 ⊂hPQ*4∀c↔!∃≤\zJB∧
IJ0K]J(∀≤*
I¬∀⎇Xyα¬≥J*T≥%Z(R∧Ld¬∧
J
:T∃≥I~E-$→hphP→*%≥"
8$c⊂↔5∧<-D∧u*αz:T∀d~5∩∧4z$¬*¬yλU∀-hZ"∧MD ∃~∧iyblt→APPM
Z4B¬¬H⊂hP→ E∃Rλ∃BD
⊃Q M¬Z9∧R¬¬J4∀c⊃Q LU*:B¬≤)F@hP_[∧≤Bλ∃BEα⊃Q LE*+"∧
Eλ∩Hh!~¬-≤ $¬αe8)Cλh!→$4≤AQ LE*+"∧∩E
αHh*8$c+!~5,∩
¬E∪;¬6⊂hP~
U≤D$
αeD9ye_h!→%∃≥D
∧⎇∧&⊃PU≤)FCPL
*%R∧∃HαEα⊃Q M¬Z9∧R¬¬J4∀c⊃Q LU*:B¬∧zλ∀Ph!→∧e∃$λ"dα
¬⊂hP→*%≥"
8$c(Q*4∀c'!∃$did¬%"J;⊂hP→*%≥"
8$c∀!Q LE*+"∧∩Eλ∩Hh*8$c∀↔!∀De+$¬"bλ%⊂hP_8∀L*
EE
≥X)DM_Q!∃∧⎇ $¬α`Q!∀E∃+$∧
bλ%⊂hP→ E∃Rλ∃BD
⊃Q LU*:B¬∧z #λh!Q%≤∀F(#PL*YU∧rλ∃D≥∧z hP→
%∃Rλ%DdLJ
$⎇¬1Q LU*:B¬≤)F$λh `h*:T∃%IA∃≤ XZ∧t XZα∧ hD∧ e λ∀d-::hPQ*4 lX d lZπ M$K(∩∧"HA∪]
8Z2∧|iK∩∧
H%E"eJED"Q(∀e∧λ→D-≥:π LlzhTJ∧EJ∀d-::K\XZ5"¬
(U≤-*hR∧~H~#
d~&$
e%Hbαα∞<V*¬9z%"HQ!∃≤\zJB∧
J;⊂hP∀ %,m d∧
d→J∧c Q!∃≤\zJB∧∩J;⊂hP∀ %,m d∧∩d→J∧c(Q(∀e∧Fπ M¬Z9α¬αH!PPM
Z4DR
¬E∧txZ@hP_[∧≤Bλ∃BEα⊃Q M¬Z9∧R¬¬J∧t<ZAPPM zα¬αH!⊂HK8j$|J iu*∧yaB∧
λ∃~¬ h∀l* xbβ∀hD∧
∀uD∧∩∧xdβ
≥AQ LU*:B∧ J EβλQ(∀e∧F7 LE*+"∧
Eλ∩Hh!→¬∃∃$λ"bD%⊃PT J Eβ !→%,mλT∧∩d→J∧c⊂Q!∀U,ZλR∧
Hh∀e≤Q⊃∪\|d
4 lX bb∧Iz4*∧_dβ∀tDλ∃∀:
*Tu~ zU"∧(Xd⎇∀Tε∃≥ Q!∀De+$¬"bλ∃⊂HK9yb∧ J ∧ bD D⎇≤T ∀2β)hB∧
(t∧M~
9∧⎇∃HZ"¬$λ→bβ
:APPLYzd*¬EE¬"HQ!∀De+$¬%"Eλ"HH↔8dm∩
8∀l- aB¬<→IB¬∀XJU∀r i∀b∧_aPPH⊃⊃∪]¬yt∧
∀T
Tt-~X∀b∧→`λ
9s1(
⊂0q!Q@0p)YH∃ ¬
∃
"!↔sSh →β#'P∩c⊂!gT)"ah∪g"$g⊃P(& PbiP T P"hU`fεEαP%))U⊂ f(∪→FE∧R*fh"H"⊂ FALSE 9BUT NOT EQQAL IN SAMENAMEP MEANS LOSE
MOVE TT,(TT) 9IUST DO SOH
A!β∪$A→≠$A)!
Aβ→A⊃β→ M' ~∀%→'⊃ε↓(XZb$∩vAπ=≠!β%∀A)≡A]∪≤XAM∪∃π
↓!≥β≠∀A/∨%⊃&Aβ%∀~∀&≤
6≥α"bRP$KYα2≡<Jεε1∧"εR¬bα:>Q∧
J&RDj⊗Rε_h(%αU∩NQα4
2N∀HIeJ: αεJ≥¬~RJ&≥"2eαd*NMα$Bε)α4JJNPhP&*J≥!αRJ,($%m∀r⊃αε∀9αNR∀JεB2Jα≡J⊗
"⊗Iα$Bε)α4JJNPhP4*εeα1IhL*b∞!∧ 2⊂4PJ*V6∧)α⊃∩tzP$%\J→αεeα"ε1bα↑&9¬:"ε9∧ α:>rj:V0hP$$∧KZn~>RG IS PROPER SUBSTRING OF 2ND]
POPJ P, ;IF SAMEPN, WIN WHEN A NUL
9[FOR CORRESPONDENTS HAVE BEEN EQUAL ALL ALONG]
ALPL5: EXCH A,B ;FIRST ARG SYMBOL, SECGND ARG ISN'T.
PUSHJ P,ALPL6
JRST [EXCH A,B
JRST ALPL0]
SKIPE D
↓ MOVEI D,QGREATERP
JRST ALPL7
ALPL4: PUSHJ P,ALPL6
JRST ALPL0
ALPL7: PUSHJ P,[PUSH P,A
SKIPN D
MOVEI D,QSAMEPNAMEP
PUSH P,D
PUSH P,B
MOVNI T,3
XCT SENDI ;Send the object a message
]
ALPL5X: PUSHJ FXP,RST5M1
JRST POP1J
;; CHECKS TO SEE IF ACC A HOLDS A USER HUNK. SKIPS IF SO.
ALPL6: SKIPE USRHNK ;IF USERHUNKS NOT ENABLED, OR IF THIS NON-SYM
TLNN TT,HNK ; ARGUMENT ISN'T A HUNK, THEN LET PNGET BARF
POPJ P, ; ABOUT NOT GETTING A SYMBOL
PUSHJ P,USRHNP ;IS IT A USER-HUNK?
JUMPE T,CPOPJ ;NOPE, SO EXIT WITH NO SKIP
POP P,T
PUSHJ FXP,SAV5 ;YES, SO SKIP AND LEAVE ACC'S STACKD UP
JRST 1(T)
SYSP: MOVEI B,TRUTH ;SUBR 1 - DETERMINE WHETHER SYMBOL HAS
SYSP3:
10% CAIGE A,BEGFUN ; A "SYSTEM" SUBR PROPERTY
10$ CAIL A,ENDFUN
JRST FALSE
10% CAIG A,ENDFUN
10$ CAIL A,BEGFUN
JRST BRETJ
CAIGE A,BSYSAR ; ... OR MAYBE A SYSTEM ARRAY PROPERTY
JRST SYSP6
CAIGE A,ESYSAR
JRST BRETJ ;RETURNS T FOR SUBR/SAR POINTERS
CAIE B,QAUTOLOAD
JRST SYSP6
CAIL A,BSYSAP
CAIL A,ESYSAP
α JRST FALSE
JRST BRETJ
SYSP6: JSP T,SPATOM ;RETURNS FALSE FOR NON-SYMBOLS
JRST FALSE
PUSH P,A ;TRY THE AUTOLOAD PROPERTY FIRST
MOVEI B,QAUTOLOAD
PUSHJ P,$GET
JUMPN A,SYSPZ
SYSPZ1: POP P,A
MOVEI B,ASBRL
PUSHJ P,GETL1
JUMPE A,CPOPJ ;RETURNS FALSE FOR SYMBOLS WITH NO FN PROPS
HLRZ B,(A) ;RETURNS NAME OF PROPERTY OF ONE IS FOUND,
JSP T,%CADR
JRST SYSP3 9 AND THE PROPERTY VALUE PASSES THE SYSP TEST
¬
SYSPZ: CAIL A,BSYSAP
CAIL A,ESYSAP
∀∩A∃%'PA'3'A4bα∩mβ+)∨1∨βλAA%∨! I)2A≥=(A'3M) ~OL@ZA∂<A∨≤~(∪!∨ ↓ Yα∩$∩w →M
A
→U'⊂A'Qβπ⊗A= Aα~(∪≠∨-∃∩AαYEβ+)∨1∨βλ∩mβ≥λAI !+¬8Aβ+)=→∨βλ4∀∪!∨A∀A X4∀~∀~)∂π)/∧t∪∃+5!
Aα1∂π)/$~∀∪⊃1%4Aα0QαR~(∪!+'!∀A Y9∨)≥∨P~∀∪≠=- ~A∧Y-∂πQ/α~∀%∃%'(↓∂π)/`~∃∂πQ/∩t∪M )∂~↓∪%≠-_~∃∂πQ/0t∪5∨- ∩↓αY∪≤@~∀∪'-∪!∂
↓∪%≠-_~∀∪β⊃ ∩Aα0b~∀∪M↔∪!
↓-∂π)]α~∀∪¬ αA∧Xb`~(∪!∨!(A X~(_∩∃'U¬))_%π∨!3M3≠¬∨0A
+≥
)∪∨≤4∀~∃π=!3'35¬∨_t4∀∪∃'@A(Y'Aβ)∨~4∀∩A∃M A(YA≥∂
∩4∃π!'dft∪∃U≠!≤AλYπ!'d`∩∩w% A≥∨8[≥∪_↓' π∨9λAβ%≤Aπ∨!dA!→∪M(XA- Aβ≥λ↓β%∂&4∃π!'dt∪!+M⊃∀A 1!≥∂(@∩∩wπ=!2A)!
A'35¬∨_~(∪∃%'PA'3π=≥&~∀4∃π!'d`t∪!U'⊂A 1α∩∩wMβ-
A=→λA'e≠¬∨_4∀∪!+M⊃∀A 1π!'2$∩w∂ PAαA≥∃.Aπ∨A2~∀∪∃1π⊂A∧XQ R$∩w'βY
A≥ \Aπ∨!dXA∂ PA∨→λ4∀∪!+M⊂A Y∧∩∩wπ¬-
A∨1λA∨≤↓)∨ A= A')¬π⊗~∀%⊃%%4↓αXQα$∩∩w∂∃(A!→%'(~∀%∃+≠!∀AαYπA'2b∩$w∪ A9≡A!→%'(A)! ≤A)I2A-β1+
Aπ∃→_~∀%≠∨- $A∧Y≥%_∩∩w9∨.A∂∃(AαA9 .Aπ=!2A∨_A)⊃
↓!→∪'P~∀∪!U'⊃∀A→1 Y'¬,k~f4∀∪!+M⊃∀A 0]β!!∃≥λ~∀%!+'⊃(A
1 1%'(k4f~∀∪!%%~A∧YZb! R∩∩m')∨%∀A∪≤A9 .A'e≠¬∨_4∃π!'dbt∪'-∪!≤A∧XQ R4∀∩A∃I'(AπA'2h~(∪⊃→%hAαXQ∧R∩∩wA∨∪≥)∃$A)≡↓∨→λAM3≠¬∨0A¬→∨
⊗~∀∪!→%4APXbQα$∩∩wβI∂&A!I∨! %Q2~∀∪)+≠!
↓(X\VL∩∩w∪_A≥∨≥∀A)⊃ 8A ∨≤≥(A⊃β
⊗~∀∩↓⊃→%4↓)(Y4bQ R$∩vA 1'
Aπ=!2A)!
Aβ%≥&A!¬=! %)d~∀∩A!%→~APXbQ)PR~∀∪!%%4A∧YQα$∩∩w∂∃(Aπ∨9) ≥)LA∨ AYβ→+
↓π →_4∀∪πβ%≤AαYE+≥¬∨U≥λ∩∩lA∪ AU≥¬∨+9λA ∨8O(A¬=)⊃ $↓π∨!3%≥∞~∀$A∃%'PA&c!¬∀~∃πA'2ht% 1π⊂↓β$bX4bQ R$∩w →M
Aπ∨A2A-ε↓¬2A =∪≥∞A∧@Q' PA≥ .↓∨→λR4∀∪∃'@A(X]M (~∀% 1π⊂↓β$bX4bQ R4∀∪∃%M(A&cAβ∀~∀_~∃'U¬))_%' )'e≥)β0↓β≥λA=)⊃ $↓% β ∃$A'39)β0A→+≥π %∨≥&~(~∀wβI∂&AβI
Aπ⊃¬$@QβLA≥+≠ $A∨HAβ)∨4RXA'e≥)β05π∨
0A≠βπI≡[∨$5)%β≥M→β)∪=≤~∀~)' )'e≥)β0h∪' )hAβ$b0∩w'+ $@f~(∪≠∨-∃∩Aβ$IαXQ∧$~∀β∃M A(YM!β)∨4~∀β∃I'(A%M'3≤b4∀∪∃'@A(Yπ!≥,b~(∪∃' ↓(Y
∪`cα~∃I''3≤Dt∪πβ%_Aβ$IαY#≠¬π%≡~(∪∃%'PA%''e≤d~∀%ββ∪
↓β$eα1#'!→%π∪≥∞4∀∪∃%M(A%'M3≤f~(∪≠∨-∃∩Aβ$DY7#'A→∪π∪9∞XY≥%→:
∃I''3≤Ht∪≠∨Y
A∧Y∧~∀∪!U'⊂A 1π!%+∀~∀∪!U'⊂A 1β$b~(∪∃%'PA''≠ hf~∀4∃%''e≤ft∪5∨-'∩↓β$bXP```@$∩w/βdA)≡A→β↔
A=+(A'M3≤`~(∪≠∨-∃∩A∧X!αR~∀%∃+≠!∀AεY%M'3≤j$∩w'↔% A∪ ↓≥≡Aπ!)%β≤↓')+
_~∀∪!U'⊃∧A@Y%''e≤h~∀%⊃%%54AαXQ→1 R~(∪≠∨-∃∩AαX!∧R$KZ2>NLr≥αJ-"J>~M!α~>∩α0∃≥J:@hP→Yu$,∀λ"bD5⊃PPM
Z4DR
¬E≥≤9
E∀ aQ M≥X$∧5E¬J#;α6⊃PU∃:;∀s+!→%,mλT∧
∪(⊃E%∃XQ∪MD~D∧L2 ir¬≥→jD
B
:E,4aQ L≤→_R∧
&(∩e
9→d<DQQ LU*:B¬∃:;∀s8Q)e:(~
U≤Bλk¬αe6fββ+ε PhTht@M¬Z9α∧5
¬E]∃5j4≥≥QQ LlzhTJ∧5E∧5E¬⊃P@L**5"¬*:5Ls↓Q%∃≥9→c+Pα33jHαP!V⊂i→ FB∧h*iR%⊂(⊗∀)i`→N4
α HLRZS (@
1 $~∃%'M3≤pt4∀∪≠∨Y ∩Aα0Q∧R∩$p∞">≤J:
α∀*RJ>4JQα~⎇⊃α:N$
P4(Lj>J⊗Jα 1"~H4(&¬*N" ¬↓2NNα;∀u$≠↓PPM:X"∧5λ¬E∪;¬6⊂hT8¬∀JX.B2J*uλ∃
*1#"AQTTtk→M∞B*
4r⊂⊃,(⊗)
XεE∧SdπVEI A,(C)
α JSP T SPATOM
POPB P,
α MOREI A( B ;SAVE B
JSP T,CHNT1~∀%≠↔- $AαXQQ(R
∀%≠↔- $A∧XQ R∩g∀*N@$z(R∧⊂Q!∀l]hY∩∧~EλeEα⊃↔5≤-Dλ2¬$tλ$*∧i≠∧u,T tb¬Izα∧|d
∧$`Q!∀U≥∧
Be∃9
5 h!→T⎇∀T
E"dλ*5E$!Q LlzhTj¬JABD5α∀
!QB4∪j H⊂ ↓Q@↓Aα@
SSCHTRAN:~∃9.J∪'-∪!αA_Y7⊃∃∩5αIbBRQ&hh*:] JN.&∧ α→2\"B α⊂¬E@6 λ _L_⊃`∀T,,]]
λ¬''≥J:RεCP4*:αtPLLzj4J∧eE∧E∀IPλ
%
⊃∃¬∃ εE'∃R∧fgUα@
A 13⊂∩∩⊂∧¬∩e6∩∪≠≠∧¬5%"EKUhhαB4
Zpλ∀¬Ktp∀IXls#!↓33uJ9(⊂4F∃α~__ _∧D]S'idg⊃P!a'PβK
SSSYN⊃8λ
∀∪5≠% ∩↓αP⊃α⊂H%nIz4L@Qh⊂j)prc!↓33uHY(⊂C¬λ*#"A~∃0r $∀ ⊃j(u∩"!↔qq5∧ 3Q⊃+∧⊃StD
Pu⊂∩e*'P⊃∧@
TLNE AR1,40000 90λ`@@`A¬∪PA'β3LAβ-β0@g%λααεJ≤hP&*NααQ2~DrQL4PJ*NA¬!2N⊗≥⊃H$%\b0≤≤αh⊂)Hλ∀q*J4λ∀H:α⊂ i∀ hP(∃)⊂$g∃'P"*βE`b⊃$P"* ∀"∀FB∧l!jλ# ;MAP∩AM↔∪ @!
∨$@!')β)U&Aπ⊃Q%β≤R$~∀∪+9→↔!∨A∀∩g≠U'(A¬∀A∨≥→dA∨
↓∪∃' I+π)∪=_\~∃9.J∪)1_
*λJBc#εεK]99∃α¬YiD-≥4 T ≥)t∧ D~!PTutA∃$dhT¬%"E
%~tX_2K]99∃α¬YiD-≥4 T ≥)t∧ D~!PPLYzd,JλJBbDE⊃∪M4q(λ9⊂4P(:⊃4@λ~h∩5
4∪usDλr∃∀H→C"B*I⊗H∃
E ,#!!53S :∪t∩AQA"Qj(u∩.A→Ttλ
E⊃R∪Jf@.qhZλ∀Q(_∃⊂0IH(∩3HH4β"J8)"0h→1q(λE∪P4h92#"J8)α0h→1q(λE , &↓ B2JY4⊃q$λ ⊂t z∩C"A→TTu∧λtPu _!"C!*q00j)nC"A→3uQ)∀⊂K
λ∃#"B*
4r∩D
⊃tH:α$FEαe)h⊂∃⊗)faT→αE∧Pb"⊂*∃⊗"εE∀daiλN∧fgk⊃dP V∪αIL
MOVE C,(TT)
UNLOCKI
NW% TLNN C,400
NW$ TLNN C,(RS.MAC)
POPJ P, ;EXIT WIP@ NIL IF NO MACRO CHAR
NW% TLNE C(40
NW$ TRNE C( %&9β→(~(∪≠∨-∃∩AαYE'!→∪
∪∃∞∩m'!→∪
∪∃∞AH P, A
NW$ PUSHJ P, GETMAC
NW$ HRRZ B, (A) ;CDR OF ASSQ IS FUNCTION
NW$ POP P, A
PUSHJ P,XCONS
POPJ P,
IFN NEWRD,[
;;;ROUTINE TO GET MACRO ENTRY. CHAR IN D.
;;; CLOBBERS A, B, TT, RETURNS (CHAR . FCN) IN A
;;; RSXST MUST HAVE BEEN DONE
GETMAC: MOVEI A, 206 ;GET FCN LIST FROM READTABLE
HRRZ B, @RSXTB ;..
MOVE A, D ;CHARACTER
PUSHJ P, IASSQF ;DEPENDS ON D,R,F BEING PRESERVED
↓JUMPE A, [LERR [SIXBIT/IACRO CHARACTER VANISHED#!!/]]
POPJ P,
] ;END OF IFN NEWRD
SSMACRO:
CAME T,XC-3 ;CROCK TO GET NSTAT UP FAST
PUSH P,R70
POP P,A
POP P,C
POP P,B
SKIPE A
PUSHJ P,ACONS
PUSH P,A
SSMC43: PUSHJ P,GRCTI
JSP T,SMCR2
ADD TT,D
HRRZM TT,RM4
JUMPE C,SSM1
NW% HRLI C,404500
NW$ MOVE C,[RS.CMS]
SKIPE A,(P)
JRST SSM3
SSM4:
EXCH C,@RM4
NW% HRRZ A,C
NW% TLNE C,4000
NW% PUSHJ P,SSGCREL ;CLOBBERS C
IFN NEWRD,[
TLNN C,(RS.MAC)
JRST SSM4AA
PUSHJ P, GETMAC
;REMOVE PREVIOUS MACRO FUNCTION FROM ASSQ LIST.
;**** (SETQ MAC-LIST (DELQ A MAC-LIST)) ****
SSM4AA: ;AND NO GCREL CRUFT NECC.
]
MOVE C,@RM4
NW% HRRZ A,C
NW% TLNE C,4000
NW% PUSHJ P,SSGCPRO
NW% HRRM A,@RM4
NW$ DPB D, [001100,,@RM4] ;MACROS MUST HAVE SELF AS CHTRAN
NW$ MOVE B, D ;***SURELY THIS COULD BE A LOT LESS KLUDGEY***
NW$ PUSHJ P, XCONS
NW$ MOVE B, A
NW$ MOVEI A, 206
NW$ MOVE A, @RSXTB
NW$ PUSHJ P, XCONS
NW$ MOVE B, A
NW$ MOVEI A, 206
NW$ MOVEM B, @RSXTB
SUB P,R70+1
MOVE TT,RM4
JRST SMCR1
SSM3: MOVEI AR1,(B)
HLRZ A,(A)
JSP T,CHNV1
CAIN TT,"S ;S@LICINGP
αNW% TLO C,40
NW$ TRO C,RS.ALT
MOVEI B,(AR1)
JRST SSM4
SMCR2: LOCKI
JRST RSXST
SSM1: HRLI D,2
MOVE C,RCT0(D)
NW% TLNE C,4000 ;WAS IT ORIGINALLY A MACRO CHAR?
NW$ TLNE C,(RS.MAC)
MOVE C,D
JRST SSM4
SSGCREL: TDZA D,D ;MUST HAVE USER IJTERRUPTS OFF
SSGCPRO: MKVEI D,1
JSP T,SPATGM
JRST SSGCP!
HLRZ T,(A) ;GET SYMBOL BLOCK, FIRST WORD
MOVE T$(T)
TLNE T,SY.CCJ ;IF SYM NOT PROTECTED BECAUSE OF BEINC
POPJ P, 9 "NEEDED" BQ COIPILED CODE, THEN PROLIS-IFY
SSGCP12 SORE A B
HRRZ R,(B)
↓CAIGE R,200
HBL R,VREADTABLE
HRRI R,IN0(R)
MOVE B,PROLIS
∪∃U≠!
A⊂Y''∂I_b~∀%!+'⊃(A YβM'∨ε~(∪∃+≠A
AαYM'!%∨D~∀β⊃1%4Aα0QαR~(∪≠∨-∃~AαX4bQ R4⊃''!I∨"t∪5∨%
AλY$~∀%!+'⊃(A Yπ=≥&b~(∪≠∨-∀A∧XZDQ B~(∪!+π!∀A Yaπ↔≥ε4∀∪≠∨Y
A∧YA%∨→∪L~∀β!U'⊃∧A@Yπ∨≥L~∀β≠=) ~A∧Y!%∨1∪&~∀%≠↔-
↓αXJb! R
∃M'!%∨`t∪!∨@A Y∧4∀∪∃%M(A!∨@c∀~∀4∃''∂I_dt∪5∨%
A∧XZbQ@R~∃'M∂%_bh∪!+'!∀A Y%β''#_∩∩w∪9) %≥¬_Aβ'M"A/∪Q⊂A≥≡↓π⊃ π-∪≥∞~(∩A∃%M(A''A%∨0∩$r@A≥<A'π∪@A∨≤A→β∪→+I
A)≡↓
∪≥λ4⊂∪⊃%I0A∧X!R$KY↓αN\JAα≡p∧¬≥,88U≥_Q!∀E∃+$¬"bλ∃⊂hPα0p)X(∀C¬
""'_pπfh⊂i"iP∀"`b*⊂a&"P⊂g"⊂'∃da"iβE JRSP SSGRL2
MOVE B,PROLIS
↓PUSH@∀A@X] 1 ∩∀hP&6>4*5α¬eαJ>2M_4(→Yu (2(⊂%IR3β!↓2TTjD∀pt
)vβ"@↓A ¬εE⊂jj'f∪`b≥∧B]j⊂)R'jf"λ!cg*⊂dg⊂*∩ P ∪YMBOL NAME, A CHOULD
HRL A,T ; COH
)β%≤A)⊃∀Aβ+)=→∨βλ↓!%∨!∃%)2~(∪!+'!∀A Y¬π∨≥&4∀∪≠∨Y'&@Q∧R~∀∪A+'⊂A@Yα∩w→∨$A∂ A!%∨Q π)∪=≤∩∀∪A+'⊂A→1 Iλ4∀∪≠∨Y'∩Aλ0QαR~(∪⊃%%$AλXb@``∩w¬+)∨→=βλA+M $A∪9) %%U!(~∀%!+'⊃(A Y+%≥(~∀%!∨ A→1 Yλ4∀∪∃%M(A!∨@c∀~∀_~¬∪→≤A∪)LY6~∀4∃'+¬Q)_∪'e'πβ→0A
+≥
)∪∨≤4∀∩∃'e'πβ→0t∩∀∪5∨- ∩↓λY#'e'πβ→0~∀βπ¬≠_A(12Zb`9:~∀∪
β≠→
↓(Y1ε4d~∀∩↓∃%'(↓/≥β→='
~∀%≠∨- $AλXd! R~∀%β λA⊂Y(∩∩$wλA!=∪∃)&↓)≡AβI∞A/∪Q⊂@]π¬→_A≥¬≠
A∪8A∪(~(∪≠∨-9~A(YM3'π_`∩∩fG¬%∂&VH~∀β∃M A(XA!+'⊂,dQ(R$w!+' A'→∨Q&A
∨HAπ∨!e∪≥∞A→∪1≥ 4Aβ%∂L~∃'πM_`t∪5∨-
A∧XZbQ⊂R~∀∪)' A(1
1≥,D∩∩vY
∨∃)%=_[¬∪Q&|XXq≥+≠¬∃$[∨ 5∨+)!U)&[ ∃'∪% ⊂|~∀∪!→_Aλ1)(~∀%⊃%%5LA)(~(∪πβ∪1
A)(0d`~∀$A∃%'PA'π'Q≠α~∀%⊃%→~↓)(Y'e'π_p$∩vGβ9'/ %LXXGβI∂&Vd4∀∪≠∨Y
AαX!λR
∀%!+'⊂↓
1 Y⊂~∀∪!U'⊃∧A@Y'∪15β⊗~∀%≠∨-'$AλXQM )4R4∀∪ ⊃
⊂AλX!
1 R$∩w)⊃∀A' )hA∂ LA!+(↓∨#(A! %
~(∪≠∨-∃∩A$X4bQ
⊃@R~∀∪5∨- ∩↓ XQ
a R
∀%!+'⊂↓
1 YQ(∩∩wQ⊃αAπ%1¬∪(↓
∨$AQ⊃αA≥¬≠
A∨_A)⊃
]πβ→0~∀β⊃1%4A(αb⊂4λM"2iα a5D4PJR2≥¬!1UAβ$%nαI∧*∧9ye%∀yD∧∧MJ4∧
∀qQ LU*:B¬≤:9C λQ!PU≤:9C P∀ ¬∃∃$
BbDE⊃PPM99u%"
ED5@Q!∩∧U*:B¬≤:9C λQ!∀l⎇hT¬%"E
BHh!→T⎇∀YP¬%"E
"Hh!→T⎇∀Y∀¬"b
%⊂hP~:T∀J
%Cλh*85≤c_∪ M¬Z9α∧5λ¬E h!→T⎇∀Y∀∧
∪∃E¬"HQ!∀823@λ~L+∃
*5∩β!!(∪3jH2(⊂*&+∃∃ →1P#!!33uHY(∃β¬λ4L"!⊃.p
$∩iP$iH g⊂$S&$g"H!gb"Q⊂,#$S"hεEαf)d∃⊗∩ibQf'cFB∧fgk⊃P*⊗)U∀*∀FB∧j&'∪⊂*⊗)PFE∧P∩))j∀aif≠βE MOTE T ASAR(AR1) ;H +'PAβ→'<A⊃β-∀A
∪→∀A¬∪(↓' (~(∪)2tqαQ∩
→:
&ebεM:Tz%n b2>]∧*&Bα-⊃α*>⊂α6Iα4J2∀∀PIα*J≥!αN∞≤aP$(Lj>J∃¬"Q2n¬"RNε∃h4(__D$jλJBbDi
αHh*85≤cdεC!!0p2(x(⊃ ¬
λ""'d#ghλ*#P$S)j f∪⊂)"fPdg$g⊃P$g(∃j⊂ i⊃iFE∧H ge H"⊗)aTd_FEαd&)-λ ⊗)lTaf≤εB∧ige∪⊂"⊗)Pif~εB∧fgk⊃dP"ε T#$(
FE∧d∀&$P* →___βE)aiS→]∧h∃id⊂#⊗(⊗*∧B]` OOP TO IH
' ¬→_Aβ9'/ $ααJ⊗F,*NRLhP&ε∩$IαQ1λh(&N|R≡∃α bN∞Nc_4*N≥~1QhLj>JNJαQ1"≤*Ri$HI`≤4→h∀b¬8ZEB¬9_tt J4∧,@Qλ∪hd∀⊂4H→10
"T)FE∧RdπRMT,(FXP) ;[PHERE WILL ALWAYS BE ATLAAST ONE, I.E. THE CKNTRMH]
MOVEI TT F.CHAN
.CALL (F)
JRST SCSFAI
SETZB A,B
↓HLRZ D,SYSCL8
SCSL5* JUMPE D,SCSXIT ;DOOP TO LISTIFY UP NUMERIC ANSWERS
POP FXP,TT
PUSHJ P,CKNSFX
α SOJA D,SCSL5
SCSDMA: MOVEI TT,15
JRST SCSXT1
SCSFAI: ,SUSET [.RBCHN,,R]
.CALL SCSTAT
.FALUE
LDB TT,[220600,,D]
MOVE D,SYSCL8
HLRS D
SUB FXP,D ;TAKE OFF DHE SLOTS FOR ANSWERS
JSP T,FXCKNS ;LISP NUMBER FOR ERROR CODE
SCSXIT: MOVE D,SYSCL8 ;SYSCL8 HAS 2+#ARGS
ADDI D,-1(D)↓ ;PUSHED WAS 3+2*#ARGS
HRLS D ; WHICH IS 2*SYSCL8-1
SUB FXP,D
SCSXT1: MOVE D,SYSCL8
HRLS D
SUB P,D ;STRAIGHTEN UP P
POPJ P,
SCSTAT: SETZ
SIXBIT \STATUS\ ;GET CHANNEL STATUS
,,R ;CHANNEL #
402000,,D ;STATUS WORD
.SEE IKCERR
,SEE CHNI1
] ;END OF IFN ITS
$INSRT STATUS ;HAIRY SDATUS FUNCTIONS
SUBTTL AURSORPOS FUNCTION
IFN USELESS,[
¬
CURSORPOS:
MOVEI D,QCURSORPOS ;LSUBR (0 . 3)
↓CAMGE T,XC-3 ;MORA @)!β≤A$BJε∃∧
J∞M∧b>N⊗_h(%αU∩NQα<rε2>≤(4(→*Tm∧T
Bd≥*:%β⊃↔4L2 ir∧
(z2b∧~4∧4⎇$λD,4~YE"¬JK⊂hT8*5∃¬4εB*9r4∪Dλ4L#¬
λ∧DDNbf)bH& ijλ i#@∪`h BE TTY FILE ARRAY
JRSTARSBN
∪≠=(
⊗%¬"Q1"
⊃E$∀PJ2N!¬"Q1⊗≤*≡2>8h(&N\JB∞∃¬~Q"R H4(∀ %∃≥Dλ5∃≥)ZhPα0p)→H⊂4F∃∃∀U*Iα".iH4uλ~Qh∂$
β"B$ ∀TVDλ4L#
@⊂j,gBDX MEANS THE DEFAULT TTY
C@%M$b`t%∞ε6pαQ2b~iL$%\20≥∩λ¬∩
(1(⊂*(th∪*Zuλ∩λ~Q(⊂$λR3⊃$λ4TP+⊃"B( *Tuλ~TpTπ↓"B2J:λ∃∃¬K⊃Stj↓".qIZH∪sHT⊂πi⊂∃+cP T!iP&PlP'iλ&`lFB∧P%)∀j⊂!i∀i(⊂∧B]P''U⊂ k⊃P P#∩d∧E ARRAY
IFNSFA,[
↓ JRST CRSFA⊃ 3FILE¬
CRSFA5: SUB P,R70+1 9SFA
CRSFAY2 SETZ C,
α AOJE T,CRSFA2 ;OJE LESS ARG; ONLY 1 ARG, ARG TO SFA IS NIL
POP P,A ;LISTIFY THE ARGS
PUSHJ P,NCONS ;GENERATE THE INITIAL LIST
AOSN T ;TWO ARGS/
JRST CRSFA4
POP P,B
JSP T,%XCKNS ;NOW THE LIST IS IN A
CRSFA48 MOVEI C,(A)
CRSFA2: MOTEI B,QCURSORPOS ;CURSORPOS OPERATIMN
MOVEI A,(AR1) ;THE SFA ITSELF
JRST ISTCSH
CRSFAZ: HRRO AR1,V%TYO ;GET FILE AS SPECIFIED BY 'T'
JSP TT,XFOSP ;CHECK FOR IT BEINC A SFA
JRST (F) ;NOPE
JRST (F)
SOJA T,CRSFAY ;A SFA, HANDLE SPECIALLY
] ;END IFN SFA
CRSRP8:
IFN SFA,[
JSP TT,XFOSP ;CHECK IF FILE OR SFA
JFCL
SKIPA ;NOT SFA
JRST CRSFA5 ;SFA
CRSFA1: ] ;END IFN SFA
SUB P,R70+1 ;IF WE HAVE ONE, IT MUST
PUSH FXP,T ; BE A BONA FIDE TTY OQTPUT FILE
PUSHJ P,TOFLOK
UNLOCKI
POP FXP,T
AOSA T
CRSRP0:
SFA% HRRO AR1,V%TYO
SFA$ JSP F,CRSFAZ ;TRAP OUT IF A SFA
↓JSP R,PDLA2(T)
MOVEI TT,F.MODE
MOVE D,@TTSAR(AR1)
SKIPGE AR1 ;IF FILE NOT EXPLICIPLY GIVEN
↓ SKIPN TTYOFF ; THEN ↑W NOL-NIL => REPUBN NIL
SKIPA
JRST FALSE
↓JUMPE T,CRSRP1 ;0 ARGS - GET POSITION
AOJE T,CRSRP3 ;1 ARG - SPECAAL HACKS (NP CODES)
SKOTT A,FX
↓ JRST CRSR11
¬
;2 ARGS
MOREI D,"V ;SET VERTICAL POSITIOF
PUSHJ P,CRSRP5
CBSR20: MKVEI D,"H ;@'∃(A⊃∨I∪5∨≥Qβ_A!='∪)∪=≤~∀∪5∨- ∩↓αXQ∧$~∃π¬M% j@PJ*V6∧)α¬2%∩V∀$KZ:&1∧j⊗ε:~α:=α≤Bε:≡(h(&*≥↓αQ∩5B:YDhP&N.Mα≡∃α% 4(∀
4-%$
E"`⊃↔4t x~DMQ(⊂*(h∪SjD⊂3∪ zq1β!!0p2)H(⊃∃¬F-Mb!↔sStDλ4Qhλ_SuQ$ε-Mc!!(∪3jh2(∃
E -MaQR1SD 5∀wλFL α)
S∩(λE ,
J
""'_1⊃ X1r0dε,λ∃ T⊂33jYUλ⊃IzH↔T↓QKQ3
8(α2J*uλ⊃H→∀q#!!"C"H:TpTεw@4∃*9∩H⊃IJ ⊂sJλr∩b!↔pr⊃(→h∃∪d
q1( _H⊂p*λ0R3 ~⊗(⊃+ 4q∀gq"B( *Tuλ~TtMf⊃ R1Id∩5∀kH L ↓→3uQ)∀⊂+∃
*5∩α!↔tQ5
ZSH∃
*5∩ _H⊃q$λsu
I∩4hλh4C"Ehαf)bBfgk"RP V'∩f∧DDNβRIGHT NOW, D10 SYSTEIS CANT "DO IT"λ
∀∪)%'(A
→!π H∩∩∩v↓)⊃ ≤↓ ≡Aβ
)∪∨≤αaαε: α⊗b~D¬ 95∩λ≠Q0r ⊃"C"H:TtMf↔H∪3jH2(⊂%IR3α!↔qShλ_4⊂0I→⊂5⊗%D∀sh
(5∃4Id∪R3↓Q@∧e)∀j⊂!m⊃a`λI
α;1 ARG @πβ'
4∃π%'I ft∪)' A(1'!β)=~~∧∩↓∃%'(↓∞JNα*β H↔9∀2∧it∧
¬8ε3()s λ
I⊃3@λ j*"T⊂!"P⊃$h'*SFE∧h∃id%⊂∀⊗!a)T~_∧DNcbj∪*fbi∩aP+ S*bP'Q⊂#$i∀j⊂!d⊂i⊂'cλ)lfa∪fεE!T)i(≠∞∧fgk⊃dP"ε
**∀FB∧j)!H**⊗_L_εE∧U"#"P∃*⊗-VM_.FEαP%))U⊂!a)T(→εEαfgk"H**⊗#Pa*∀*∃∀D]cYz⊂0Pλ_Q⊂!~z⊂4wλ:42P≤7yt`4ion speciFied by TT
TDNN TT,ARSBP9
JRSTARSBP2
JRST CRSRP7
¬
CRSRP4: JSP T$FXNV1
JRST CRSRP6
CRSR40: JSP T AHNV1
↓CAIL DT,140
CU@I DT,40 8ππ>u2⊗JQ¬"0~¬X
∧-∩λ8∃≤(Q!∃∧⎇ $¬α`Q!PT≥*:%βK!Q%EU'SSH)~%∧~ ¬Kp0PhHαc%f∪g( i∀h*`_Z[\]N←]
ZZX90≠5i10y'∃)5.Zβa
a→≠9yx∀U"⊗J6Lp4(≠+%PH↔8$M¬4
5∧0r1K→3Q`⊂∃αALID ZP CODE@&4∃β!!U→∂
Ai54α∩m≥∨)
hA⊂HA$XAβ≥⊂A,A≥=(A-β1∪λA⊃∃%αB~(~∀`-α$∧
∀tλ4
≤T
tM⊂λ∪IyK1R+ U3 λ~h⊃R**uλ⊂*(c"Pj*tL$'↓2U3*λ(⊂#λi)i ∧¬α JSP T1'!β)=~~∀∩↓∃%'(αα≥∃:"∪⊂H!~¬-≤ $¬αd8∧Tj& β"A→Ttλ
E⊃R∪JF@εE∧Tedh#QP"εEαibb-λ"⊗εEαa`dbH**⊗⊃∩ε@
AAINTT$"V
∩@↓∃%'(↓β%'$β L4(L~ε&9¬"Q1
Hh(%αU∩NQα≥∩NIE h*∞J≥⊃EIHM:R¬α\∩ε⊃α≥*JN>∩αε>∩*↓5α∞-∩N.J∧zMεThP&*J≥!α∞J≥⊃ED∀Ph($
≥∩NIE≠P&∞εLb∃α⊃c Y\4PJ6>Z,Iα⊃1 1\4(L
∩∩¬∧!1E@HIn!α r⊃αY¬∩ε:∩|j2eα<
:Q↓ ↓αε∩$*⊂4
≥∩NIE#P&6>5~%α⊃c!AAAβ↓"⊃∧JrN⊗∃∧~:B∞#λ%n.,*Aα2@α~J>hα
⊗&t9αj⊗∀x4(εE∩J%α"a"RQHh(&*∃~Qα∞∃~JA\hP4)mααεJ≡~α∞εN(h*∞J≥∩AEI¬αVN"RαA2~⎇∩∞∃DhP&6>4*%αR"b→:6|"∀4(Lj>Z∃∧12αR%~εI"
⊃E$4TJ~∃αM"Nr⊃∪↓1&U∩NQα4
2N∀hR&~9∧JRNr#⊃A2lhP&BV≤B)α~e↓2J∞∧zL4(M"2:∃∧12~
#b⊗
xHIn≡⊗"α⊗∞"zα6>∩*αB>NM"&>_hP%α6⎇2∃α⊃e⊂$%m∧J→α~Lb∃α&~α~>I∧*∞"=∧
Jε∧hP&6>4*%αR"a"⊃$HIn∞>u→αR",iαVA∧2>IαdzN⊗HhP&*NααQ2~MAF∧4PJ6>Z,Iα 1D $4(LB2Ji¬"Q2⊂hP&*NααQ2~MAF∧4PJ*JN"α∞>:_h*t%\*:⊃α|1α&~rα&RNd!I@4Ph*∞J≥∩6AhMαVN!∧2bA2 h*∞J≥∩5EhLB2Ji∧ 2↓"αH4(&lzZ∃α"a"~bαH4(&lzZ⊗%¬"Q1""H4(& "∩%α%!1"AHh(&B-~!αAc "RQHh(&R∀r∃αQcλ4(¬¬αVN!¬↓1I"%!$4(MαVN!¬↓2∧4PJBVNDQαA2≥∩NJB_h(&"∃∩iα¬d↓"A$hP&6>4*5α¬bBA$∀PJ*V6∧qα¬2≥∩NJ5λh(&B⎇↓α~bαbP4*≥∩NJ9PJ6>Z,Iα¬2%∩VR hP&*J≥!αBJ|:9D∀Ph*t$KZ⊗:⊃∧z→α&4qαVN,b⊗NLhP4(04*≥*
RR`JJε:$z5αJ⎇*R&:-→αR=∧Bε:∩d)α¬α¬~⊗V∩zαε2&≥ 4(4R)⊗~Vt~R&>sP&6>4*%α⊃e ∃⊗~,r∞R&|p4(&U*6B∃∧ 2↑: 2>N∀hP&"J∃Qα
1D $4(LRV6Brα
2↑t
~>N(h(&"e∩iα bB¬$$KZ"ε22jεNN,!α~Vt
J≥α∀J:∩&t84(&E∩J>%¬"Q1"≥↓$$%\z:¬αdAαεM∧:>>⊃∧
MαεtzR"⊗⊂h(&*≥↓αQ24JaF∧hQ:
Vt→Qh&¬*N")¬↓2b∞|rL4(Lj>Z⊗Jα 2F5*:εJ8h(&*∃~Qαb≤z:L4Ph*ε⊗4
1h&≤Z&B∃∧ 1"AHH%nB-∩B>N,beα∞∀JBB∩Lr≥αB⎇:⊗Iα|1αε2M~P4(Jα*NA¬!2~bu1D$%ZαJ>V$J:∃i∧2>>⊗J ↓5α<bL4(MαVN"RαA2εdJNP$KZ⊗Jεbα↑&RBαε9α b&NPhP&NV∩αA2I;↓-D4PJB>A¬↓2∧4PJN.&∧)αP$HIfε2M~QαJ-"VJ:Lr≥α:|q6j⊗∀yα&9¬!↓uxhP%αB-~!αAd~εV:∀J:⊂%ZαR↑=∧∩&:⊃∧∩2>∞]→α↑⊗∀)αBV≤B⊗⊂4PJBVNBαA2∞
*:
&t 4(&∧zB)α5BA04P04λhQmmm∧
2&N ∧∧≥∀X~D-~λ→b∧,ji∃∀|iXTu"λ~2¬≥λX4L4_XB∧∃∀λ∩∧<~hTr∧∃YDM≥EaPS[74∧ rλ∃TdM:D∧l
∀λ$+PQ'3[X≠6∃j∧i→Bb∧XX∀tLht¬$DT
D⎇αYHU4,DλTu4~)ttlYjBph'73XM6+R¬"D T, i→d:¬IλR∧≥Z*$,uDλTu4~)ttlYjBαE8XR¬[KU∩ph'73XM6;R∧
λi∃DuYT¬∀-
(U≤,jI∀t~λ∀¬≥∧X:∧$b
tLuHZ"b∧~1PS[71∩αα∧
$-¬X)d,"λ+∩¬$λT∧-∀→He∀ XT∧5,h:DL\dλ∃~¬IλR∧4zZ%$@Q'3[X∀∧αα∧~HTjrλI∧M~ →d$L8~D-~
I∧*∧YjdM∀yiT,uDλ∃~∧xaPS[71∩αα∧
DD
λ:∧,≤_i∀,"λj$ lUaPS[71∃[%T¬αCe;→T∀|GdαrβJh∀e,Wa∩αrπH∩ld~:CrHQ'3[X∀∧αα¬Iλ∃"∧~5B∧|jIr∧|hT∧|2
I∧*∧zI∧-∩
I¬∀,T 4LtJ4∧|2λ∃TdM:APS[71∩αα∧ tt(∪0+∀⊂ssJ4⊂1⊃ ~⊂3sH→λ∃P*)00SλU5P3
X(∀⊂)~Th∩)a"Nng⊃(λλ∧
∩⊃(
Zu03∧ 03SHZKH∃ 4h∩*4⊂(λJJU1(λ∃3∩4jDKC"G7nh∃ 4h⊃)jR4Sii13U∧ 4h⊂j(05⊃(D⊂V(
(0R3HI3Qhλ→∪λ∃H~R00IH4c"G7nh∃i 0rλ λ5Q(λ(13Hλ)u3Q∧
r3PhT∃∩⊃)d⊂P0i4∃∪h
I⊃24D s⊃
H3∃1*5β"Ng↔h∪tD
∪h∃ λ(⊃P)J14h
:⊃0r(i11λλ (∃∩λT∃∀U(T⊂+3 ~u @ _H⊂ λy5Q3AQLnnd
P4R(_S⊃(
X4h⊂Iz3Qλ
85Q4H→λ∃∩)X4kλ yS⊗( yQ(∀HXR3Q →Qh∩*4⊃∪sHQ"Nng∀∃∪h
(0tQ(~⊃(∃ λ(∪sλD⊃3UI~SsS(YU H
I∩4h ~h⊃∪ih(⊂V$
4r3Ht∃∩⊃!QNnnd ⊃1U∧ ⊂3⊃D qH⊂$
P3∃(T⊂q3 D∃∪h →Q∩0h~⊃(∃iλ5∩⊃*$∪tH iuλ∩*A"Nng∀∩⊂4dλ3∀Q(_⊗(⊂HXMUST BE TURNED ON DURING THIS OPERATION.
;;; EITHER ONE OR TWO SPECPDL BLOCKS ARE PUSHED, THE SECOND ONE
;;; BEING NECESSARY IF ANY TRUE A-LIST IS GIVEN. THERE ARE FOUR
;;; STEPS TO THE PROCESS:
;9; [1] CHECK ARGUMENT THOROUGHLY FOR ERRORS. IF A TRUE
;;; A-LIST IS GIVEN, ALL SYMBOLS ON THE A-LIST ARE GIVEN
;;9 VALUE CELLS IF THEY DON'T HAVE ANY ALREADY.
;;; [2] TURN ON NOQUIT. IF A TRUE A-LIST IS GIVEN, BIND ALL
;+; THE SYMBOLS AS SPECIFIED, MARKING THA FALUE CEHLS
;;; AS THEY ARE BOUND, AND NEVER BILDING A SYMBOL TWICE.
;;9 WHEN DONE, PUSH THE TRUE A-LIST ONTO THE SPECPDL
;;; SO THAT AUNBIND AAN RESTORE THINCS CORRECTLY.
;;; [3] SCAN THA CPECPDL FROM THE POINT SPECIFIED BY THE
;;; SPECPDL POINTER (FROM THA BOTTOMIF NIL), AND BILD
;9; ALL VALUES CELLS SEEN BACK TO THEIR OLD VALUES,
;;; MARKING THEM AS THEY ARE BOUND, NEVER BINDING ONE
;;; TWICE. WHEN DONE, PUSH A POIJTER ON THE CPECPDL
;;; SO THAT AUNBIND CAN RESTORE THINGS CKRRECTLY.
;;; [4] SCAN BACK OVER ALL THE ITEIS PUSHED IN STEPS 2
;;; AND 3, RESTORING THE LEFT HALVES OF ALL THE VALUE
;+; CELLS. TURN OFF NOQUIT AND CHECK FOR INTERRUPTS.
;;; ON RETURN, A-LIST LEAVES T NON-ZERO IFF TWK BIND BLMCKS
;;; WERE PUSHED. IT IS UP TO THE CALDER TO MAKE SURE THAT THE¬
;;; BLOCK(S) ARE UNBOUND CORRECTLY WIT@ AUNBIND.
;;; NOTE DHAT ERRPOP CAN RECOGNIZE THESE SPECIAL BIND BLMCKS AND
;;; CALD AUNBIND TO UNBIND THEM. DHIS IS BECAUSE THA LAST WORD
;;; PUSHED HAS ZERO IN THE LEFT HALF,
ALIST: SKIPN A,-1(P) ;MAKE CKPY OF ENVIRONMENT GIVEN A-LIST
ALST1: JUMPE C,ALST3 ;SDEP 1 - ERROR CHECKING
↓CAIN C,TRUTH
↓JRST ALSP3 ;P AND NIL ARE VALID A-LISTS
SKOTT C,LS
JRST ALST2 ;NOPE % GO CHEAK IT OUT
HLRZ AR1,(C) ;YUP - CHECC ITS CAR
HRRZ C,(C)
SKOTT AR1,DS
JRST ALST0
HLRZ A,(AR1)
SKOTT A,SY
∪∃I'(Aβ1'(`~(∪πβ∪8AαY)I+)~(∪∃%'PAβ→'P`~∧∪!→%4A¬$bXQ∧R~∀∪!%%4AλXQβ$DR~∀∪5∨% ∩↓β$bYE+≥¬∨U≥λ~∀%ββ∪≤↓∧Y'+9¬∨+≥⊂~∀β∃M A(X9' (b4∀∪∃%M(Aβ→M(b~∀_∩∧~)β→'λHp∪)→9≤A)(1
0∩∩l@ZA ¬%≤A/∃→_A¬∃)) $↓¬∃α
α~&bu*44(LRJNQ∧
2NQh(&"∃∩iαR"a"
$HIf&V≥!α
∃∧ αZεdJ⊃αN∧*∞B∩bαB>&u"⊗H4PJεε6bαRQ2U~
H4PJεε&d)αRQbBNA$hP&*J≥!αε2≥!@$* bNAMPJ"22⎇→α:>
*&P$KZRVJrα>)αtzFV&"↓5α6αZ5$rzD∧LuHZ%∃-
APPL ID⎇~ ZTt=↓⊃∪L )zU"¬It∧m,ht¬$ JXR∧≤YIE~λQ!∀l]hYR¬≥¬J5¬≥a⊃∪M≥HZαβ∩¬T¬¬-9∧∧∧dx92∧4z ¬%∃XT∧
lI~5 h!~4-%$
B`H⊃↔5"¬y→Db∧(X4|@1(∪IyK6Q*)h∩1D
∀U1!QB4ri~∪H⊂eE,*∀¬⊃".hλ∃3∩4jD∩4h
Q4q)jλ⊂5∧λ3∪β!(3∀uε8.B2JY4⊃(λ5⊂3∀jFα".ii3λ⊃Izαg"εB∧a`dS⊂!V*∀*j$εB∧e))U⊂ f)U≠DD]U⊂#'jS"εE∧Tegj*λ!R&)CEe)∀j⊂ f∀j~ DB]c$l∪*fP#∪h¬ND
HLRZ B,(C)
HRRZ C((C)
↓HLRZ A,(B) 8παA⊃¬&Aβ)=≠∪εAM3≠¬∨0~∀β⊃I%4AβHbPA∧$∩∩wβHbA↓βLAβ''=β∪β)∃λA-β1+
∀%⊃→%4↓∧XQα$~∀β⊃I%4Aα0Q∧R~(∪'↔∪A∂
AβHeαXQ∧R∩∩wM↔∪ AU≥→ 'LA-β→U
Aπ 1_A≠βI↔ λ~(∩A∃%M(Aβ→M(gα∩$s%β→U
Aπ 1_Aβ→I β 2↓% ¬∨U≥λ~∀%⊃%→∩↓β$eα0QαR∩$p∞BV≤A↓rZ bV∃α≤*211d~VJJ,rQαZ bV∃XhP&BV≤AαNAd
IJ∧HIeα≡u"5αN∧*∞B∩cYαR",qα&:≥"ε20hP&"J∀z5αε∪ 1"¬HH%mα4
2V∃∧2J>5∧*:Z&∀z:6⊗u!1α6
∩.&::αε⊗2`h(&ε|R¬αQd
2NQ≤λ$%n"α:>9mR⊗J=βiyα↑*αBVND*⊃αN|j⊗R →d8h!Q$ e:FCPLYzd,Jλ5E≤≠!⊃∪\t→Dβkr
Iuα∧HZd,bλYe4M)ydl,jAPT J:C$ !→¬∃∃$λ2bD5⊃⊂K\i≠∧u,TπSr¬:λT≤Li_T"∧YjdM∀yiT,uAQ LE*+"∧∩J:¬≥0Q!∀U,ZλR¬"H→E≥#H1⊂K\_d∧ u~I∧Ltt
¬-≤λXBb¬:H∃∃" hU*∧)It≤XQ!∃¬-9∧¬≥αER∩Eα⊃⊃∪\dXjB∧D→Hb∧∀ZJD-∩λ(R¬TZ)rλh!~¬-≤∧
5αe:
50H↔8dLt~9α∧|hd∧∀dx92∧4z$¬%∃XT∧
lI~5 h!→T⎇4YT¬≥αJ:¬≥0⊃↔5≥$~*B∧tZp∧∀dx92∧4z$∧5,h~$:¬ y∀u$Z!PT J:C$≠!→T⎇4Y∀¬%"Eλ2HH↔:5$-∧ε2αj
84 rλ:∧,≥λIB∧5)yR∧,ji∃∀|iXTu Q(∀e≥FW L≤→→b¬%EE∧∩H⊃↔2∧∀_92¬-∧
Dz¬ y∀u"
y∧,rλ→DM≥Dλ4 dHX@hP→*%≥"λ→E≥#aQ LE*+"∧
&∃BE%E⊃⊂K\xZB¬4→JT*∧j)tj¬:λT≥∧IAPPL8→T<*λ~#
e*83⊂H↔9∀<tz(R¬≥λX5∧$D
∧|LjHU∃_Q!∀U∃:D∧ e:FTλh!_4 LxT∧
∪∃E¬≥α⊃Q L y(∩¬%EH∀e≥FQPT J:C, !→∧e∃$λ∩bEJE⊂HK8xU"¬h→E,*λ8Tdbλj$|J
9D⎇ Q!∀U,ZλR∧
H→C, !⊃∪\Lyiu∀*λj$|∃4λ∀dM:D¬¬-9λU~λQ!∀≤ _T∧
e
y∀|LjA⊂K]yλ∃"∧∀ D⎇≤Z$αjjλItr=D T-≥4
tM$∧
DDM4⊃PPJ
94M∧xT∧
∪(∃BD
⊃↔4L<iz$*∧X~$\,D
d eXT∧≤,IJ0hT→FT ∪!∀∧ |(∀¬%"H→E≥#QQ LE)I∩∧
&(∩bD∃⊃⊂K\YJ4*¬
Z4B∧~4∧∀,iz$(h!~¬-≤∧
5αd~&$λh!→¬∃∀yT∧
∪∃E∧
HQ!∀ |(∀¬%"H→E≥#QQ `h!Q$ e:FsPL
*%R∧5ES
E¬⊃⊂K]DπSr∧:Z%∀,jD∧,ui~$|tXYe h!~4-%$
B`H⊃↔4|tK∀∧|tTλ$d|94¬¬-9λT h!→¬∃∃$λ"e≥
:`hT→J5#3!~¬-≤∧
5αd1⊃∪]≥HZαβ"¬T¬∀-:Iu∀*
h∀e,Tλ4,dJ1PT J:C4 !_4 Ldλ"bE:¬⊂hP∀ %∃≥Dλ∀e≥Fx⊂hP→ E∃Rλ∃BD∩⊃Q LUYZ∧*∧∃H∀e≥Fh hP_8∀l<Tλ∩eU86 hP∀ ¬∃∃*4αD
⊃Q$ e:Fd∪P_→tT
λ%D e:Fdλh!Q$ e:Ft P~
U≤B
:αe≥λ:`HK89D⎇≤Tλ$LtDλ$d|91PPL IEU~ ZTt=↓⊃∪]∀→JT*∧8YDe~
Ydm,hxT h!→%∃≥Dλ5T 9 ⊂HK8→Db∧Iyd*αTλ4D 94∧LuHZ%∃-
J0hPQ'3[Zλ~Tt∀→hB¬,hIt-~λ∀∧5,h~$:∧)→d"∧)It≤Z
U≤DXD∧¬Jλ→DM≥EaPS[74∧M"λIt-~
9r∧∃∀
4≤ ii∀d:
Zα¬$λT¬≥∧X:∧$bλj$|J
I∧*¬ y∀u" x`hS572¬$λT∧5,h~$:∧YjdM∀yiT,uED∧⎇∩λ+∩¬≤8→dtLht∧$⎇yd¬$DT
E∃,Tλ∩ld~:B`h'73J∧9It∀∀Z)∀t:λ:U∃∀YjB¬4→JTt∀→hB¬,hIt-~λ∀∧5,h~$:∧)→d"∧)It≤Z
U≤DXD∧¬Jλ→DM≥EaPS[74∧M"λIt-~
9r∧∃∀
4≤ ii∀t~
Zα¬$λT¬≥∧X:∧$bλj$|J
I∧*¬ y∀u" x`hS572¬$λT∧5,h~$:∧YjdM∀yiT,uED∧⎇∩λ+∩¬≤8→ddLht∧$⎇y`¬$DT
E∃,Tλ∩ld~:B`h'73@4⊂s∪h(Q4R)Hh⊂u**Q3U∧
P3∃(Zh⊃TIyαP# S*bP!Qd")P∩e*'P∀h"ah⊃&εE≥N]P)f∪h)P'T⊂ Vf∩ij⊂)S'j)P⊂iP h∀)'h)∩`j"Vλ)cP*∩ j⊂ S,P!bU(SiFB≥]]P⊃'g"P∩e⊂"$⊃P!i"Pj"b⊂⊂eh,P∪c⊂"$⊃P"g+∩i'g&Qe*⊂+Rf BE
;;9 REFLAC@)∃λAβ≤ααR"∃∧zJ&≡Lrε1α,rR&J|r6⊗:"p4(Q(∃,T)→d#PQ!∃∧⎇∧
5αeAQ$
,h)cβP→Yu (3(∃
E∃3PIh c"A→3uQ)T⊃ ⊂*YPQβ!!33uHY(⊂Cλ~3PTAQ@∧fgUαEM F,AUNBF
MOREI F,1(T)
α HRRR R,(S@)
∪π¬≠∂
AHY5'εH~∀αA)%'(A¬+≥¬≤P~∃β+9¬≤bt%∞ε&p∧∧2b
:αHH↔84d|((U∩¬8ZE
=4λ$ ≤4 ∀u$t
5∧,8λD`H!∀∧U∃:@∧
,h)c_h!→∧e∃$λBbDe⊃PT
Yh$s∪αB2 JTH∃
Eλ∀@∀CE CAIE @)PXQλR4⊂∩Aβ=∃αA$αbεV:∀qH$(LBJJI¬"Q1"%!$4λLBJJ5¬"Q1α⊂¬⊂hPα03i((⊃Kλ~3PSF⊃"C"H~3PSF7@33jHαP#⊗⊂jg!#βE MOTA B AUNBR
∪≠=)αAλ1β+≥¬⊂~∀β'UA'1$n`VD~∀&U∩NAα,r
:⊃h $
*:
9#P$$∧KZ∞ $x($-∩λ8U%
z4∧∧ 90∧LUIt¬%∃XT∧
lI~5 h(~Tt∀fW L≤→→b∧2E
5αHQ!∩∧U*:B∧
Yh$c_Q!∀De+$∧"bλe⊂hPα2TJ:λ⊂5)hSMc!!"P5)hSMNA→∀TVD
K
∀E⊃ P5)hSInA→∪∀VD
∃
%!"B) ∀VH
J
∃
E!"B) ∀VH
J
∃
E!"B)
TVH
J
∃
E!"B(_21(
J
⊃¬⊃"B( *Tuλ~3PSFa"B2 JVH∃
E
∀B!Q@2∀J+H⊃ ¬λ
#"A→∀TS$λ
∃
E!"B(→pP λe⊂53H)M#"AQC"C!! C"AQA"R(~
⊂&A→3uQ)T∃∃β
!.p5∧
∩∩4d
∪r3JEλ∃q$ 02q$
4λ⊂)a B2
*Sr(
J
∀j¬!"B)*tλ∃¬HR6 (⊃"B4
Zrλ∀¬H#"B)YuQ(
J ∀C!!33uIi(∀@⊗ εE∧fSk'$P∃⊗_FEαe))jλ$`h~CEαE T#'#]αd))-λ V∀!
DD]`T(&,P⊃*g i⊃FE∧d∪))⊂! ∀!∀FB∧d))∪P!⊗∀⊂TFE∧T*id⊂∀⊗ FEαfgk"SP*⊗ T#'#XCEh*Td%⊂( f$iUεE∧h∃id⊂( ↔εE∧R))'dH**⊗⊗L∀(∀FB∧fgk⊃P"⊗ T#'#XCE∧h'T⊂**⊗ ∀**∀CE`gR&"P" ↔⊗XFB!`jg⊂$g"≥βEfgU"dP" jg!∩g"εEαfgk"SP"⊗→
**∀FB∧iedT'⊂*εB∧P&gU"dP" !h'h∩εE∧fSk"fP⊃⊗_T*∃∀FE∧Sgk"P∃⊗ h#∪!XFEαe))jλ$`h(∪,FEεBεE h∪!&≥∧R&)-⊂⊂V∀!∀CEd)∀-⊂!⊗
!∀FEαd&)-λ i_V
!∀FEαfgk"SP iλK∀!TFB∧fgk⊃fP!h )h!kα]`h(∪,P& P"f⊂"V()"iTdggεB∧h*iR%⊂(⊗⊂$g"εB∧h*iR%⊂(⊗⊂ A,-1(C)
HLLM A,-1(C)
PUSH FXP,A
JRST IAPPLY
APLBL1: PUSHJ P,UNBIND
POPJ FXP,
SUBTTL LISTIFY, PNPUT, AND PNGET
LISTIFY:
SKIPN R,ARGLOC
JRST LFYER
JSP T,FXNV1 ;LISTIFY UP N ARGS FOR AN LSUBR
MOVM D,TT
CAMLE D,@ARGNUM
JRST LFY0
JUMPGE TT,LFY3
ADD R,@ARGNUM
SUBI R (D)
LFY3: HRLOI TT,(D! ;SEE HAKMEM (A.I* MEMO 239) ITEI !56
EQVI TT,(R ;@)PA∂ )L@x[≤4b|XXqπ∨≥)∃≥)&A= Aβ%≥→∨ε|4∀∪β∨ ∃ A)PY
β→M
∩∩wi %≡A¬%∂&~(∪!+' A Y$\`~∧∪5∨- ∩↓$XQ $∩∩w(↓⊃∨→ LA→β'PA!∨∪9) $~)→
"bh∪≠∨-∀AαXQQ(R∩∩m∂ (A¬%∞~∀%∃' APY! →9≠⊗~∀%!+'⊃(A Y≥
∨∃&~(∪⊃%%4AαXQHR∩∩w
→∨¬¬∃$A∨≥Q≡A ≥⊂A∨ A1∪'(~(∪≠∨-∃∩A$X!αR∩∩mβ -β9π
A→¬'(A!=∪≥) H~∀∪β=¬∃≤AQ(Y→
db~∀∪)%'(AA∨!β∀4∀~∀~)!≥!+Pt∪∃+5!
A∧1'3π∨9&~∀∪A+'⊂A@Yα~∀%' )54A→!≥_~∀∪∃I'(A∪9)%≤b4∀~∀IA≥∂ (h∪!+'!∀A YA≥∂ (4∀∪≠∨Y
AεY∧~∀β∃M A(Y→1≥,d4∀∪≠∨Y ∩A∧0`~∀∪
β∪≤AQ(VbX\~∀∪!=!∀A 0~∀∪π¬∪
A)PVbXl4∀∪→ I$A7'%1¬∪(↓9
βQ+%
A9∨(A3∃(A∪≠A→ ≠ 9) λ@4A!≥∂∃(C9:4∀∪) iαAλY⊂~∀I!9∞]$t%!+'⊃(A Yπ=≥'
04∀∪' Q4A)(0~∀∪≠=-
A$16`h`X``HYQ):~∀⊃!≥∞fh∪)→≥8AλXnX````4∀∪∃%M(@I!9∞]λ~(I!≥∞Mαt∪)1≥≤A$0n```@`~∧∪)%'(@⊃!≥∞]H~∀I!9∞ht∪%→ ∧APYλ∩∩m∂ (A9 1(A¬'π∪∩↓¬3)
4∀∪∃+5!
A(0I!≥∂`~∀βπ¬∪∂
APXbh`$∩wπ⊃∃π⊗A
=$A→∨] $[π¬'
~∀%β ∩↓(Xh`$∩wπ∨9- %(0Aβ≥λ↓')∨%∀~∀∪∪⊃!∧A(1$~∀∪)%'(@⊃!≥∞f4∀A!≥≤]λt∪)+≠!
↓εPI!9∂0~∀%⊃→%4↓ XQε$∩∩wπ=≥')%Uπ(A/=%λA∨_Aβ'π%∩PAβ9λA¬!Q$A)⊃∃% )≡4∀∪≠∨Y
A X! R~∀%⊃%%4↓εPQε$~∀∪≠=-αAλ16`h`\``HY→:~∀∪)%'(@⊃!≥∞g∧~∀I!9∂0t∪)+≠!
↓)(X\,d~∀∪A+'⊃∀↓ Yπ∨9'
0~(∪∃%'PA≥% Y %'
4∀∩∀~(~∀~∀4∀~∃'U¬))_% 1β≠%≥
XA⊃ !∨'%(XA≠¬↔≥+~0A≠+≥-β~~∀4∀~∃ ∃!∨'∪Pt∩∩∩m
∪%'PAβ%∞↓∪&A
%1≥+~↓β %∃'&X@I≥λA∪LA-β→U
~∀∪∃1π⊂A∧Y∧~∀%∃' APY
1≥Xd∩∩w≥ (Aβ⊃$A∪≥Q≡A)(,b~∀∪)' A(1
→)'- ∩∩w≥ (A ¬)αA∪9)≡A)P~∀β∃→π_~∀%≠∨- 4A)(X!)(Vb$∩∩w↓∃%
∨%4A !='∪(~(∪∃%'PA)%+∀~∀~∃∃1β≠∪9
t
∀%!+'⊂↓ Yπ
%0b
∀%∃' APY
!≥Xb~∀∪5∨-
AQ(XQ)PR~∀∪A∨!∧A@X~∀~)≠β↔≥U~t∪≠=- ∩AQ(XQα$~∀β∃I'(A
%0b
∀4∃≠+≥-β~t∪)' A(1
1≥,D~∀β≠=) ∩A∧XQ)($~∀∪!=!∀A 0~∀_~∃'U¬))_%'→ @XAβ→¬%≠π→=π⊗~∀4∀vvvQ' ∃ @y≤xRA'→∃ !&A→∨$@y8|A'
∨∃ &8@@y≤xA≠β2↓¬
Aα↓
∪1≥U~A∨$↓
→∨≥U~\~∀4∀A'→∃ t∪)' A(1
→)'- ∩∩wM+¬$@D~∀
∃%
≤A∪Q'9λd@Y6~∀$A∃' ↓(Y~f@\~∀∩A
≠!HA)(Ym)≠π≥M):~∀$@A∃'@A(Y∪→∪0~∃%(H∩]M→ ↓)(X∩$w∪)&ZZA'1 A→∨$@yQ(|@fA)⊂O&↓∨ Aα↓' π∨9λ~¬∪→≤Aλd@Y6~∃M! π!I≡A∪≥Q'→ ∩$∩wλd@@ZZAM→ ↓
∨$@q)(|A5∪→ ∪M π'∨9 &~∀%≠∨-
bY)($∩v@Q∧RA/
↓/β≥(↓)≡Aβ1→∨.A%≥) %I+!)&↓)≡A∂<A)⊃%=+∂⊂~(∪ ∪'5&∩∩∩l@Q∧R↓/
A≠U'(A¬∃+β%
↓∨ AπI+λA∪8Aβε@D~∃1πQ!%≡~(∪' )h@bX~)≥∨!%<~∃:∩$w ≥λ↓∨ A∪→≤Aλd@~∃:∩m ∃λA%
≤A∪Q'9λd@~∀~∃%
≤AλD`Y6~(∪πβ∪∧~∀∩@↓∃' APY∪
∪`~∀∪'1 AQ(X∩∩m'→ @A
∨$y)(|↓' π∨9 &~∃t∩w ≥⊂A∪
≤↓λb`~(~∀∪∃I'(A)I+
~∀4∃∪
≤↓∪)&Yl~∃β→¬%≠π→=π⊗t~(∪ 1π AαY∧4∀∪' Q≡A)(0~∀∪π¬∪
A∧1"I%+9)∪≠
4∀∩A∃I'(Aβ1π⊗b~(∪∃+≠A
AαY¬→π⊗f$∩w≥∪0@z|AQ+%≤A=
Aπ1∨π⊗~(∪∃' ↓(Y
→Q'↔ ∩$w%+≤↓)∪≠
↓∪∀A≠%π%∨'∃π∨≥ LX~∀∩↓∃%'(\Vd∩$rAβπ
+%β)∀A)≡@P\A+'∃εA∃∪→
∪ &4∀∪∃'@A(Y∪→∪0~∀%β'⊂AQ(XZd4∃β→π,ft∩]M+' (↓6U'%Q≠$XYQ):~∃¬→π⊗hh∪∃+≠A_A)(1
β→'∀~∀∪∃I'(A)I+
~∀4∃β→π,bt∪π¬∪
A∧1"I)∪5
~∀∩↓∃%'(↓β→π⊗@~∀β∃U≠!
A∧Yβ→π,j∩∩w9∪_@zxA)+%8A∨
↓π→∨π,~∀β∃M A(Y→→)'↔@∩∩w¬∃β_A)%≠
A∪8A' π=≥ &X4∀∩A∃M A(Y4f`\∩$rAβπ
+%β)∀A)≡@La)⊂OL~∀α@↓
≠!%$A)(X!)≠π≥M(R~∀$@A∃'@A(Y∪→∪0~∀%β'⊂AQ(Xb~)β→π⊗Tt∪≠∨Y'∩A$0h```@`~∧∪)+≠!_↓)(Yβ1β⊗d~(∪∃+≠A≤A)(1β→π⊗\~∀β≠=- ∩AQ(Xb∩$s∪ @@A'!
∪
∪ ⊂XA+'∀@b↑f@A' π=≥~∃¬→π⊗nh∪≠∨-∀A$Y6X````@XY))t~∃β→
⊗dt∩9% β→PA$X~(∪∃%'PAβ→π,h~∀~):∩∩w∃→A∨_A∪
≤↓∪!&~(~∃∪
8A∪)'qλd`Yl~∃~f@\tβ∪5+→∩AQ(Y)≠aβ≥'($s∃∨)∀p α∩⎇*
2∃¬~.&A¬∩⊗@%X∧SAQ@2TJ:λ B
E!"W!↔q3Q∧ 1S@ ~∀s⊃ε&β"C!↓A Tu(*∃∪α*(33pED⊂4QeD∀q5λ~Qc"AQTQ3)xLB2J:λ∃
:⊂5∪iQ".tjXTH $¬(∀Q)YuQ(λ~∪s2(4∀v3()sλ⊃J)s(∪h(4TP+⊃"B( *tλ∃¬J∪Qq!⊃.q4J)tH∩(d⊂4Qd Suλλ∀∀r3()sβ"A→⊃pri⊃"B4
Zr∩H
¬∩3UλZSC"A→TTu∧
Q33hεc"C!*Q33h&NB3 xpr#!*Q33hεnB1+λrλ⊂%HB.sh*⊂Sλλ*0rq*Dλh∀i u3⊃∧λQ(∩)d∃∃β!!33uHT∀K∃
A B2
*TH⊃¬JSpP**P6#!!2∀TI∀∃∃ λ
∃∀p*%⊃
#!!4∃4i H∀ λ~T1uεA"B2 JVH∃¬E⊂*#!!0p2)d∃
λ%!"B$ TTu∧
Q33hε!"THY3pLg!33uHT⊃ ⊂!Q@2∀J+H⊂+¬λ*#"A→∪∀VD
⊂%⊃"B0h→1(∃¬E⊂J#!!(∩TJ:λ∀Q)YpLc!!2∀TK∧∃
λ∃#"B)
TS(
E
⊃
!QTQ3)xM∞B) ∀VH
J
⊂E⊃,¬f"Pk"P U'fP$⊃`b"iλ$g⊂*βEd)∀-⊂** _T**
DYf"Pk"P(∪ fbP∪$g%P∩e⊂"*βEe)T⊂*⊗#Ph≤&∧Na`"aRP*'P∀bbP*∩ j⊂)PeiP T P ∩EMOVED FROM SCO TABLE.
SETZB A,B
UNLKPOPJ
REMOB1: HRRZ A,(A)
JSP T,.STOR0
α JRST REMOB4
ARG: JUMPE A,ARG3 ;SUBR 1 - FETCH LSUBR ARGUMENT
ARGXX: JSP R,ARGCOM
HRRZ A,(D)
JRST PDLLKB
ARG3: SKIPN ARGLOC ;(ARG NIL) @%∃)+%≥LA≥+≠ $A∨_A→' $Aβ%≥+≠ ≥Q&~∀∩↓∃%'(↓β%∂π4b~∀∪!%%$A∧Yβ%∂9+~
∀%∃%'(↓! ≥-∀~∀~)' )βI∞tβ∃M A$Y¬%∂π∨4∩∩w≥*
I↓∩↓5αN-!α2N,∩Iαε∀:V&⊗u 4(εlzZ¬α
b4λLRNAα"bB∩∩tj,4(LBJJ5∧ 1"⊃Hh(&B⎇α)αA`h(4*
∩≡∞≡kP&N.Mα9α⊃d
J≡2|_4(¬∧RJNQ∧
J≡∞k4(εU~AαQd2b:Yλh(&*,jB2∃¬"Q2ε∀:∞5`hP&∞εlb∃αR bαεJ<rV4∀PIα*J≥!αεJ<~5`4PJε∩⊃∧!2RPhP&*J≥!↓"IHh(04λhRNF
%"0&Ar"aαεt!α~JL*:αLhP4(&≤∩Nf5PJ*NI¬α>~_KZ~&:"αNV
∩α0∀ XTαD J$∧LRλ)α∧|d¬bHh!~d≤e;→SPL*:"¬∧xh`K\i→d"∧~Itj∧iz"¬44¬∧ %$ ∀r∧I∧|2¬e⊂hP~h5≥LW!∀U≥$
∧|4a↔44LhD∧
$yP∧4⎇$
d EXT∧≤,IAPPMIJ5Lk!→%≥∩
t40↔:¬∀LjD¬≥"λYe%∃∀ t2∧HXe"∧λ→D2∧xd∧
∧8YD`h!~E≥LW!∀U≥$
∧|4a↔5≥"λYe%∃∀ t2¬)_tE" λ∀d0Q!∃∧e;→SPL*:"¬∧xh`K]λ)∀u" HT5" λ∀d2 xb∧
λ8Td`Q!∃¬≥→S LU:$¬∧|ha∪@:∀R3JD∀R1i
λ∩⊂)HH∪qDλ(⊂q)Iβ"B* qNB)*tH∀ xQB.j
R3U∧λ4Qh¬
∪r3JH4H⊂*D∪∪pdε
#!!5∪qG!2TtD
⊃qQA↔tuλYU∀V$ qH⊂*(h
∀ y3U⊃*$∩3@εF
#"I~α∩∧h gc#≥αe)i⊂∀'c#∧Nc'i⊂ P*,h⊃gjj∪gb"P∩e⊂""∃εE≥h∪c#≥∧L∧E()VfX]∧Tbj'fH()dfQεE∧fSk"fP∃⊗()fU)DD]T↔∩,ελ"'g"H$g⊂"⊃*⊗εEαfgk"SP)⊗(∀di)DB]P+dS&⊂()∩e*⊂!Se*"g∃)FE∧Sek"dH*⊗&(∀fj!∧B]P'cλ!ji)⊃g*⊂'T g⊂!Qd&εEαfgk"H)⊗ (∀fj!⊗LT*∀DNP g∪$ih⊂⊃'i&`U↔εE∧Sek"fH)⊗()SiVXD∃∀FE∧Tge'∃⊗↔⊗YβE$c"H$j)V⊗FE_X ∧d))⊗⊂*⊗↔∩!""*λεE_X ∧d))⊗⊂*⊗
∀*∀DB]kd U⊂ P%S*b#bHP⊂≠∨HPFE→ ∩∧fgU"dP* ≠_∧DNh∧ERRIBLE KLUDGE! 60
10$ CAIG R,POF
MKVEM T,PS,S
] 3END OF IFE ITS
HRRZ T,POFF
PUSH P,CPSYMX
JSP T,ERSTP
MOREM P,ERRTN
HRRZ R,POFF
IFN ITS,[
MOVEI T,40
↓MOVAM T,PS.S
MOVEI T,THIRTY+7
%OFF+1
MOVEM T,PS.S
CAIG R,POF
.BREAK 12,PSMST
] ;EJD OF IFN ITS
JSP T,SPECBIND
α TTYOFF
TAPWRT
V.RSET
IFN USELESS, SETZM TYOSW
HRRZ AR1,V%TYO ;U@DATE OUR NOTION OF THE
MOVE T,ASAR(AR1)
MOVA TT,TTSAR(AR1)
TLNE T,AS.SFA+AS.FIL
TLNN TT,TTS.TY
JRST PSYM2
PUSHJ P,TTYBR1 ; LINENUM AND AHARPOS OF THE TTY,
MOVEI TT,AT.LNN ; SINCE DDT HAS SCREWED IT ALL UP.
HLRZM D,@TTSAR(AR1)
↓MOVEI TT,AT.CHS
HRRZM D,@TTSAR(AR1)
;;; FALLS THRU
;;; FALLS IN
PSYM2: MOVE T PSMTS ;AT THIS POINT ALL ACS WIHD HAVE BEEN
MOVE R,PSMRS ; RESTORED SO THAT MOVA A,@ WILL WORK.
MOVE A,PCMS
MOVE AR1,PSMS+AR1-A
MOVE A,@PS.S ;THUS THIS STUFF WORKS IF . IS AN AC.
HRRZ T,POFF
IT$ CAIN T,P%OFF+1
IT$ JRST PSYMP1
CAIN T,POF+1
MOVEI T PSYM+1
CAIN T,TOF+1
MOVEI T,TSYM+1
SUBI T,SBSYM
TRNE T,1
TLZA A,-1
HLRZS A
LSH T,-1
JRST .+1(T)
JRST PSYMSB ;SB.$X
JRST PSYMVC ;VC.$X AND VCL.$X
JRST PSYMT ;T.$X AND TL.∧X AND TP FOO$X
PSYMP: PUSHJ P,PRIN1 ;P.$X AND PL.$X AND PP FOO$X
PSYMQ: MOVEI A,TRUTH ;RETURN POINT TO GET OUT OF PSYM1
JRST ERR2
PSYMX: MOVEI T,LPSMTB
MOVE R,PSMS-1(T)
MOVEM R,@PSMTB-1(T)
SOJN T,.-2
MOVE T,PSMTS
MOVE R,PSMRS
SETZM PSYMF
CPSYMX: POPJ P,PSYMX
IFN IPS,[
PSYMP1: TLNN A,-1 ;LISP MODE TYPEOUT - HACK TWO HALVES
JRST PSYMP
PUSH P,A
HLRZ A,A
PUSHJ P,PRIN1
MOVEI A,", ;SEPARATE HALVES WITH ",,"
REPEAT 2, PUSHJ P,TYO
POP P,A
TLZ A,-1
JRST PSYMP
] ;END OF IFN ITS
PSYMSB: MOVEI B,(A)
PUSHJ P,ERRADR ;ERRADR DOES ALL THE DIRTY WORK!
JRST PSYMQ
FCN.B: SKIPE NOQUIT ;FAKE CONTROL-B INTERRUPT FROI DDT
POPJ P,
SKIPGE INTFLG
POPJ P,
;;; FALLS THRU
;;; FALLS IN
PUSH FXP,D
MOVE D,INHIBIT ;CROCK SO THAT A .5LOCKI
AOJE D,POPXDJ ; WON'T STOP US
PUSH FXP,INHIBIT
SETZM INHIBIT
MOVE D,[TTYIFA,,400000+↑B]
PUSHJ P,UINT
POP FXP,INHIBIT
POP FXP,D
POPJ P,
TOF1: SKIPA T,[TOF]
POF1: MOVEI T,POF
PUSH P,UUOH
EXCH T,UUTSV
JRST @UUTSV
PSYMVC: MOVEI T,(A)
MOVEI A,QUNBOUND
CAIN T,SUNBOUND
JRST PSYMP
SKOTT T,LS
JRST PSVC1
JSP R,GCGEN¬
PSVC2
PSVC1: MOVEI A,QM
JRST PSYMP
PSVC2: HLRZ A,(D)
HLRZ B,(A)
HRRZ A,(B)
CAIN A,(T)
JRST PSVC3
HRRZ D,(D)
JUMPN D,PSVC2
JRST GCP(A
PSVC3: HLRZ A,(D)
JRST PSYMP
;;; TABLE OF CELLS TO SAVE OVAR THE PSYM FUNCTIONS
ZZ==. ;BE SURE TO SEE PSMS IF YOU CHANGE THIS TABLE
PSMDB: ;ACCUMULATOR A MUST BE THE FIRST ITEM, AND AR1 THE FOURTH
IRP FOO,,[A,B,C,AR1,AR2A,TT,D,F,40,UUOH,UUTSV,UUTTSV,UURSV,ERBDF,FPTEM]
FOO
TERMIN
IFN USELESS,[
PRINLV
TYOSW
ABBRSW
] ;EJD OF IFN USELESS
LPSMTB==.-ZZ ;FPTEM AND PCNT ARE SAME LOCATION
IT$ PSMST: 4,,PS.S-1 ;READ VALUE OF . FROM DDT WITH .BREAK 12,
; PP - A UUO ;PP IS FOR PRINTING OUT AN ADDRESS AS AN S-EXPRESSION:
;PP 34722$X IN DDT WILL PRINT OUT 34722 AS A
9 POINTER IN LIST FORMAT.
3 TP - A UUO ;TP IS DIKE PP BUT NICELY PRINTS ST ENTRY FOR
; THAT CELL
P.=PUSHJ P,PSYM ;P.$X IS LIKE PP FOO$X GHERE FOH∞A∪LA%⊂A= \~∀%!_\{A+'⊃∀↓ Y!→M3~∩w1∪↔
A@\XA¬U(A
∨HA→A= Aπ+I% ≥(↓π →_4∃∪(H% Jk!U'⊃∧A@Y K∨→ ∩w→%↔
A 8XA¬+PAβ&A∧A (↓)3! =+(A≠=
∀%)ε\{A+'⊃∀↓ Y-πM3~∩w→∪∃λA9β∪
A= A-β1+
Aπ∃→_A¬ A∨ @8Aβ I '' L~∀β-
_\{!U'⊃∧A@Y-π→M3~∩w∧Aπ%∨M&A¬ Q/ ≤↓)ε\A¬≥A!0\∩∀∪P\p⊗B-~")ααbRNfhIf¬α≥∩6NM∧∩⊗R↑,*1αArαε*⊃¬"@$λM"19V¬*N"$
αe$J;∀hK8⊂∧:SttdλQ1∃hX3H∀ EH⊂3HD∃∀β!!4pKGZ∃0r $∀ ∀h
v3"'_R3Q∧ P31$ qH∀jXTH⊂(H∀Q4j81λ⊂K∀∀R xH C!!0PG*
4r∩D
⊃PiePB.hh2q(λ9βg ∀RMHλ[∧↓∪∃) I%+!(↓
%∨~↓ ∩PhP4(∀Ph"NV∃"R0&"q∩aα r⊃αR∀bBVI%AαNR,2_4(hRBNfm!`&B-~")ααb&@$X*¬∀H⊃↔5"rK∧¬%MλYu-"βλ⊃*HiC"A→3uQ)∀∃∃⊗
TFEαi'j⊂∃*⊗⊗iQc` OG
∪≠=)∃α%!2NQE"Q$∀PJN⊗RT⊃αQ∩_h(&6⎇22%α⊂¬C∪⊂Q*¬≥LZB∪@LJ9∧
¬EF⊂hP~J%Dr
@ ε⊃"B( *Tu
v35ε1"B3)zQ2(λ∃λJc!!5∀ShT⊂k !Q@∧P(∃id%⊂∀⊗*,gCEfgUαEI B,PS@35)(FdHQ$R~(∪πβ∪0A∧Y!M3≠)(-!'3≠Q_~∧∩↓≠↔- $A∧Y7¬'πβ∩↓8p≥}eh4(εE∩2%α⊂aQQA9↓@$*¬~f6Q∪P&&2$⊃α¬2⊂h(&*,jB∃α
bBNfm!L4(MαVN"RαA2RLx4(εU∩NQα¬~f6Q⊂h*BNLjQMhL
>*1¬⊃2BNLjQD4PJ6>Z,Iα¬1⊂`4*J-α⊗εQβ⊃1αB-~")ααbRf<hP&"2∃Qα¬2% 4(ε¬*N" ¬↓2BJLr 4(LRJNQ¬αNf6λh(4)u~⊗∃αe_$%nαI∧M~
H∀∀dT
4D⎇YHB∧∀T 4-¬Dλ4|@Tr4jH3Uβ!%Tq1$
uα"'∀∃r5 ∧∃∃sd u∩⊃*$∀∪⊂(84c"J
v35
GC"R**λ∃∀¬E⊗s∀eD⊃Tkλk ⊃S¬HSK∀k∃∀p+
Hi ∀λI∪S+πwk ⊗ U ∪V U∀⊃4EI∪RcλHK⊂v¬H⊗↔#!!04pi→(↔∃
β"UλZS23AQT∀v)Z∪∂/%e4∀v)Z∃β"AQ@↓A Tu(*∃∪α*
4R1K∪qh∀Iz5∩3HQ"C"I_SH∩*Jk⊗c!+∀⊃4I_V.B!⊃.q3JJV(∀ y3Uλ
Ih∀q*J4λ⊂$
∃0T)≠β"B)YuQ(
E⊗tr+λR5λ J∃4T)≠↔↔.hd g#QP)diQ'_P*∪P!"P⊂P("i∀dlεEαfgk"SP*⊗)Vic'_CE MOVA T YSIXBIT \DSK\] ;JEW DAVICE FAME
MOREMT,SYSDEV
MOVE T,[SIXBIT \LSPDMP\] +AND FINALLY, NEW SNAME
MOREM T,SYSSNM
MOVEI T,FEATEX ;CPLICE 'EXPERIMENTAL' INTO FEATURES LIST
MOVEM T,FEATURES
] ;END IFN ITS
IFN ITS+D20,[
PURIFY:
IFN ITS,[ ;DOESJ'T REALLY WORK FOR D10 YET
JRST NOTIJIT ;CLOBBERED BY INIT TO "SETG AR1,"
;SETO AR1, ;FOR PURIFY$G FROI DDT
MORE P,[-LFAKP-⊃,,FAKP-1]
PUSHJ P,FPUBF7
PUSHJ P,FPURF2
.VALUE [ASCIZ \:≠PURIFIED≠
\]
JRST .-1
] 3END OF IFN ITS
FPURF28 SETZB TT,PRSGLK ;ZARO PURE SEGMENT AO@¬∃≤AA)$~∀%≠∨-
↓$Y7≥A
&X1≥!
LVc:∩m5 %≡↓!+%
↓
%
↓')∨%¬∂
Aπ=+≥) I&~∀∪M )5~↓→!
L~∀β¬1(A$Y9!
2H~∀∪'∃)5~A1 1→! ∩∩wπ1 β$@ A/∨%⊃&A
%∃
A'≡↓β→/βe&A∂%¬∧A≥ \A' (4∀∩∩∩$rA∂ ↓' ∂≠∃≥)&AQ⊃∃α4JJNQ¬"& ,Tλ∩∧d→i2∧M4 d,,HX@hP⊃⊃⊂KZ
:D
∃D d-: I∃≥" xb¬≤XyT,uJ1PPM8ZD|@(∪⊃
⊃Qb!↔tq5∧
∃4Q$λS⊂1aQLL ↓→∀S∩$
∃ Hi∀s⊃AQB33jiR(∀EIT⊂1j1".tit∀q⊃*∧∃∩∀Izαcd∪'idg⊃P("i∃!&εEαfgk"H"∩-Z
_→__ ⊗(*i∃!&.DNP*'P⊃ ¬CIDE @OW TG MUNG PAGES
IPUR1:↓ILDB T D ;GET BYTE FOR NEXT PAGE
JRST .+1(T)
↓ JRST IPUR3 ;0 - DELETE¬
JRST IPUR4 ;1 - IMPURIFY
JRST IPUR⊗ ;" - PERIFY
MOVEI T,NPAGS(R) ;3 - HAIRY STUFF - DECODE FURTHER
LSH T,PAGLOG
CAMGE T,BPSL ;CODE 3 SHOULD NEVER APPEAR
↓ .VALUE ; @ELOW BINARY PROGRAM SPACE
MORE F,@VBPORG 9PAGIFY CURRENT VALUE @∨ 4∀∪β≥⊃∩A YAβ∂≠',∩∩vA !∨%∞↓ ∨/≥]β%λ~(∪πβ∪≥
A(X! R∩∩mβ≥"A
∨
@LA!β∂∀A¬ →=*A)⊃¬(Aπβ8~∀%∧RJNQ∧JBVI4λ$%m∧∩∃αB-∩&~&, 4(_8∀l:
ED¬¬9↓⊂K\→k∩∧≤xHRβ~
λ∀<*λ(U%<XYb∧∃ z$8h!∀∧U∃:@∧M¬Z A⊃,h⊂)hλ⊂T
9λ∩4d ⊃1U∧λGE BETWEEN BPSH AND HINXM
.VALUE ; DAMN WELL BETTER BE 0!!!
HRRZ F,PDLFL1 ;ANYTHING BETWEEN HINXM AND
LSH F,PAGLOG ; PDLS MUST BE PURE FREE STORAGE
CAIGE T,(F)
JRST IPUR6A
CAIGE T,BSCRSG ;SCRATCH PAGES ARE IGNORED
JUMPL AR1,IPUR3A ;PDL PAGES MAY OR MAY NOT BE FLUSHED, DEPENDING ON AR1
IPUR2:
IT$ ADDI TT,1001
20$ ADDA TT,1
TLNN D,730000 ;ONLY 20 2-BIT BYTES PER WORD, NOT 22
TLZ D,770000
AOJL R,IPUR1
20$ SETZB B,C ;ZERO OUT CRUD
MOVEI A,TRUTH
JUMPGE AR1,CPOPJ
MOVE T,[STDMSK]
MOVEM T,IMASK
IT$ MOVE T,[STDMS2]
IT$ MOVEM T,IMASK2
POPJ P,
;;; IFN ITS+D20
;;; VARIOUS PAGE FLUSHING AND PURIFYING ROUTINES FOR PURIFY
IPUR4: ;MAKE PAGE WRITABLE
IFN ITS,[
.CALL IPUR9 ;CHECK TYPE OF PAGE
.VALUE
JUMPL T,IPUR2 ;ALREADY IMPURE
IOR TT,[4400,,400000]
JUMPG T,IPUR5
.CBLK TT, ;NON-EXISTENT - GET A FRESH PAGE
.VALUE
JRST IPUR2
IPUR5: TLZ TT,4000 ;PURE - TRY TO DEPURIFY
.CBLK TT,
JSP F,IP1 ;IF WE LOSE, TRY COPYING
JRST IPUR2
IPUR9: SETZ
SIXBIT \CORTYP\
1000,,400(R)
402000,,T
] ;END OF IFN ITS
IFN D20,[
MOVE 1,TT
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
TLZ 2,-1#(PA%RD+PA%WT+PA%EX+PA%CPY)
TLNE 2,(PA%WT) ;SKIP IF NOT ALREADY WRITEABLE
JRST IPUR2
TLON 2,(PA%CPY) ;SKIP IF ALREADY COPYABLE
SPACS
JRST IPUR2
;ARG IN A IS PAGE NUMBER. PRESERVE A,TT,D,R
;MAKE SURE PAGE EXISTS. IF NOT, CREATE SOME 0'S
;LEAVE RESULT OF RPACS IN B, AND PUT .FHSLF IN LH OF A
IPURE$: HRLI A,.FHSLF
RPACS
TLNE B,(PA%PEX)
JRST (T)
HRL T,A ;CAVE PAGE NUMBER IJ LH OF T
MOVE F,B ;SAVE RPACS CALL IN F
MOVSI B,.FHSLF 9SOURCE PAGE IS 0, WHICH MUST EXIST
↓EXCH A,B
α MOVSI C((PM%RD+PM%CPY)
PMAP ;MAKE FOOOLISH PAGE EXIST
LSH B,9 ; [WHICH PROBABLY GOT LOST BY
HRLI B,1(B) ; THA "SAVE" COMMAND] BY COPYING
MOVEI C,777(B) ; THE FIRST PAGE OF THE JOB
SETZM (B)
MOVSS B
BLT B,(C) ;FOO! A PAGE OF 0'S
MOVE B,F
HLR A,T
HRLI 1,.FHSLF
JRST (T)
] ;END OF IFN D20
;MAKE PAGE READ-ONLY
IPUR6A: MOVEI T,2 ;CHANGE PURTBL ENTRY TO 2
DPB T,D
IPUR6:
IFN ITS,[
.CALL IPUR9 ;CHECK TYPE OF PAGE
.VALUE
JUMPG T,IPUR2 ;ALREADY PERE
JUMPE T,IPUR7 ;CAN'T PURIFY A NON-EXISTENT PAGE
TLZ TT,4400 ;PURIFY AN IMPURE PAGE
TRO TT,400000
.CBLK TT,
IPUR7: .VALUE
JRST IPUR2
] ;END OF IFN ITS
IFN D20,[
MOVE 1,TT
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
TLZ 2,-1#(PA%RD+PA%WT+PA%EX+PA%CPY)
TLZE 2,(PA%WT+PA%CPY) ;ALREADY READ-ONLY?
SPACS
JRST IPUR∩
] ;END OF IFN D20
;DELEPE A PAGE
IPUR3A: SKIPE NOPFLS ;NOPFLS NON-ZERO => DGNπT FLUSH PAGES
JRST IPUR2
DPB NIL →λ$∩w5 I~A∨+PA!+¬Q¬_A 9)%2~)∪!+$β→h4*L29α&%→2l4PJRJi¬"Q1Qβ↓AA@hP%:∞∀b-αR"`4(¬αrZε2,(4*tHIn⊗:"α>→αL29α&%_4*&4qα⊃Iαbl4(M~⊗R≥β 04(Lj>Z∃β⊃2RPhP&"JdI↓I1t2"N20h(&N-"i↓M`h(&Bl
@4*hH%n⊗t!α>→∧J~9α#⊃@4(LRJNQ∧JBVI⊂h(4*hH%n⊗t!α>→∧J~9αM"M.⊃∪4(∀P0$*:T∃%IA∃¬-(T∧ ] ∀∧|2λI∧*¬(X∀"¬9→e$
∧
D ∀HQPPH!Q Jk∃ECK8iu∩∧hZu∀"
y∀db
tLUD
Dj∧β00j)h⊂rλ~H∪∩*:β"TJ;∃⊂DG↓4∃4i∧∀ ⊂hi4λ#!!2Tt∧
∃ (I31C!!(λλ i3α"'~r∪u)Hλ∪Q*H4H⊂(:∃03 K(⊂p)Iβ"B$∧λλβ!
Pu∧π!"R1HT⊃Q5j( ⊗b!↔qs⊃∧
Q0Ti→pπ⊂'Q⊂(*i⊃P)"`Q* a&⊃FE$c∪⊂)`dS⊗-FEαDZ__
X_⊗⊗ ∧]g*S&⊂$iH$cg'T"bεE∀"h"`U⊂_X⊗αY⊗⊗_JW)(!S*∧]iPdf⊂!R i)FB∧DZX ~X_⊗ /$D]U aεEαDZX_
X_⊗⊗↔%αE∧BZ__~L_∩⊗/∩FE∧DM__~X ⊗⊗/&βEDZL_~X_ ⊗/&DNaiεE∀"h"`U⊂→→⊗αY⊗⊗/∪∃W!(⊂g*∧]T`df⊂⊂d i)CE*DDNbg"⊂∩c'⊂)PdfεE ¬LSE,[
REPEAT 10, 400500,,.RPCNT ;↑@ ↑A ↑B ZC ↑D ↑E ↑F NG
↓ 2,,↑H ;↑H
500500,,↑I ;TAB
↓ 400500,,↑J ;LINE-FEED
400%00,,↑K
↓ 400500,,↑L
500500,,↑M 9CARRIAGE-RETURN
REPEAT 3, 400500,,↑N+.RPCNT ;↑N ↑O ↑P
IT$ 405540,,QCTRLQ ;↑Q watch out foR XON∂XOFF
IT% 400500$,↑Q ;↑Q protocol under DOPS systems
↓ 400500,,↑R ;↑R
IT$ 405540,,QCTRLS ;@=L∪oCi
PA←kPAM←d↓1∨≤←a∨
~)∪ J∩$h``j@`XY=L∩∩w≥L∪ae←Q←G←X↓k]IKHA)∨!LAgsgQK[)f4∃% !∃β(@n0∩h``T``HYy(V]¬Aπ≥(∩m/↔%)!→ '&4∀∩∩d0Xff∩$∩wβ→PA≠∨ ∀~∃% A β(@PX∩h`@j``X1=8V]I!π≥($w'∨%Q⊃→ 'L~∃:∩$w ≥λ↓∪
AMβ∪_~(∩∩j`@j``X0h`∩∩m'!βπ∀~∀∩∩HXXhb∩∩∩v∧~∀α∩P`hj`@XY#%⊃ ¬_∩$rD
∀$∩h`hTh`XYE% '⊃@∩∩vF4∃% !∃β(@f0∩dXXλHV]%Aπ≥(∩$vH@JL~∀∩$h`hj@`XY#I #)
$∩vN~(∩∩hh@j``X0DP∩∩lP~∀∩$hb`j@`XXD$∩∩vR4∀∩∩d0XDT∩$∩vT~(∩∩b`0XDV∩$∩vV~(∩∩h`Pj``X1#∩Kε∃ ∩∩v0@Q∪≥Q %≥β0[π∨≠5α[
8R~∀∩$j`XXλZ∩∩∩lZ~∀∩$hd`n@`XXD8∩∩v\4∀∩∩h@dj``0XD↑∩$r↑~∃I ! βP@b`\0∩hXXλ`V]%Aπ≥(∩$w π%≠β_A⊃∪∂∪)L~∀∩∩HXXDt$∩∩vT4∀∩∩h@hjh`0Y#% M ≠∩∩$rv~∃I ! βP@jX∩HXXDx,]%!π9(∩∩vp@z@|}A~)% ! ¬(@dl8X∩bX0EαV]I!π≥($∩wβ→A⊃β¬ Q∪ε~∃I ! βP@fX∩HXXbfLV]%!
≥(∩∩m'#+βI
A¬%¬π↔) L~∀∩∩HdXXEx∩∩∩w
β% (4∀∩∩lHXXE>$∩∩w 9 %'
∨%
~(∩∩h`Pj``X1#∩K∧∃ ∩∩w≥%β-
Q∪≥)∃%≥β_5¬βπ↔E+∨)
5
+≤R4∃% !∃β(@dX\X∩j@bXHE∧V]%!
≥(∩∩m'≠β→0A→ )Q %&~(∩∩dX0bff∩$∩w→ →(A¬%¬π
~∀$∩h`hT``XYE% -¬¬$∩∩wY %)∪
β_A¬¬$~∃%∃! β(dX∩d0Xbnj,]%!π9(∩∩wI∪∂⊃(↓¬%βπ∀XA)∪1
∀$∩h`bT``XXDnn∩∩m%+¬∨U(~∃∪→≤@\[Iπ `ZH``X∪]β%≤Am% β Qβ¬→
↓→∨''¬∂ :~(∩∩h`Hj``X0jn∩∩m!' +⊃≡A'→¬'⊃β
% $Aπ!β%βπQ $~∀$∩`h`T``HXT`∩∩wA' + <A∨! 8A!β%∃→&~∀$∩`b`T``@1c)D$%]αN⊗V$yα∞2⎇~∃αB
∩⊗*LhP$%Uβ↓UAAbaQ@$KZBN⊗,"5αN∧
∞∀4TJ~9α≤
&1∩Xh(%α∀*Bεε"↓UQ⊃β!AAUβ↓11Iβ!-:J∧~:P%]~ε&1∧~6*R∀z2&~L*⊃α~,r:eα≤BεJε≥"⊗JLhP4*J-α⊗εQβ⊃0%Qβ↓UAAbaMAAZrJB∞u %nzααz∧4PH%QAβ)AA⊃c→AH∧KZzλ∀U∩⊗B⊗
!↓U0K!AAUβ↓11Mβ↓-:J∧~:P%]r~¬h@¬t* hb¬TqQ HK%EC≠β¬;d@H↔;d@h!Q HKVεβ+β¬EC≠β¬;dHH↔:D ⊂Q!⊂K+εεSβαβ fελsRA⊃.s∩)H+1Q(Xβ"B!⊗ λλ~L_⊂ ,300#NK
∩∩P``j@@XXf`@W=_~(∩∩j`@j``X0f``Wy~∩∩w
β%%∪¬∂
[%∃)+%≤4∃% ↓∃β(@f0∩``@T``@1c→AA∞tq-:J∧~:P%]r0∩¬it¬uQ!⊂K#∧VS#αEJ∀≥∀S∀!⊃.p∂(CEDZ _~P_ ⊗→X_
o)∧DNo)εEαDZ_~MX_⊗⊗∀aj)&∀DD]o∀FE)"T ¬AT 5, 400500,,30 -=(V]I!π≥λ$s ≡>∃""2⊗≥_4(⊃⊗"bc41⊂HK8→E"∧YxD(h*(U∧ ~Dβ##EA∪#β∧VβαbF6βα]kE2e∃λ9e K:yu∃$ HU≥_Q)∀4r¬eU∀≥F¬S βε¬B¬<~)b¬]8→∀b¬(:Cα∧Iz5≤ xTαjjλ¬tIyβ#P&⊃e#j$λ* a&⊃nFE.B]bg"λ$c'∀`dfεB,D]bS ⊂'cλ$c"P∪ ki"βE
;9; MORA ON NEXT PAGE
IFN NEWRD,[ ;NEW VERSION OF PURE READTABLE
REPEAT 11, RS.BRK+RS.SL1+RS.SL9 + .RPCNT ;GORTHLESS CONTROL CHARS
RS.BRK+RS.SL1+RS.SL9+RS.WSP + ↑I ;TAB
RS.BRK+RS.SL1+RS.SL9+RS.WSP+RS.VMO + ↑J ;LINE-FEED
RS.BRK+RS.SL1+RS.SL9 + ↑K ;↑K (WORTHLESS)
RS.BRK+RS.SL1+RS.SL9+RS.VMO + ↑L ;↑L (WORTHLESS)
RS.BRK+RS.SL1+RS.SL9+RS.WSP + ↑M ;CARRIAGE-RETURN
REPEAT 3, RS.BRK+RS.SL1+RS.SL9 + ↑N+.RPCNT ;WORTHLESS
RS.BRK+RS.SL1+RS.SL9+RS.MAC+RS.FF + ↑Q ;↑Q (fun is QCTRLQ)
RS.BRK+RS.SL1+RS.SL9 + ↑R ;↑R (WORTHLESS)
RS.BRK+RS.SL1+RS.SL9+RS.MAC+RS.FF + ↑S ;↑S (fun is QCTRLS)
REPEAT 7, RS.BRK+RS.SL1+RS.SL9 + ↑T+.RPCNT ;WORTHLESS
RS.XLT + 33 ;ALTMODE
REPEAT 4, RS.BRK+RS.SL1+RS.SL9 + 34+.RPCNT ;WORTHLESS
RS.BRK+RS.SL1+RS.SL9+RS.WSP + 40 ;SPACE
REPEAT 6, RS.XLT + !+.RPCNT ;! " # $ % &
RS.BRK+RS.SL1+RS.SL9+RS.MAC + "' ;SINGLE-QUOTE
RS.BRK+RS.SL1+RS.SL9+RS.LP + "( ;LEFT PAREN¬
RS.BRK+RS.SL1+RS.SL9+RS.RP + ) ;RIGHT PAREN
RS.XLT + "* 9ASTERISK
RS.SL1+RS.CGN + "+ ;PLUS
RS.BRK+RS.SL1+RS.SL9+RS.WSP + ", ;COMMA
RS.SL1+RS.SGN+RS.ALT + "- ;MINUS
RS.BRK+RS.CL1+RS.SL9+RS.DOT+RS.PNT + ". +DOT
RS.BRK+RS.SL1+RS.CL9+RS.SLS + "/ ;SLASH
REPEAT 10., RS.SL1+RS.DIG + "0+.RPCNT ;0 - 9
RS.XLT + : ;COLON
RS.BRK+RS.SL1+RS.SL9+RS.MAC+RS.ALT + "; ;SEMI-COLON
REPEAT 5, RS.XLT + "< + .RPCNT ;< = > ? @
REPEAT 4, RS.LTR + "A+.RPCNT 9A-D
RS.LTR + RS.SQX + "E ;E
REPEAT 21., RS.LTR + "F+.RPCNT ;F-Z
REPEAT 3, RS.XLT + 133+.RPCNT ;LBRACK BSLASH RBRACK
RS.ARR+RS.XLT + "↑ ;UP-ARROW
RS.ARR+RS.ALT+RS.XLT + #← ;ENDERSCORE
RS.BRK+RS.SL1+RS.SL9+RS.MAC + "` ;BACK-QUOTE
REPEAT 4, RS.LTR + "A+.RPCNT ;A-D L.C.
RS.LTR+RS.SQX + "E ;E L.C.
REPEAT 21., RS.LTR + "F+.RPCNT 9F-Z L.C.
REPEAT 4, RS.XLT + {+.RPCNT ;LBRACE VBAR RBRACE TILDE
RS.BRK+RS.SL1+RS.SL9+RS.RBO + 177 ;RUBOUT
RS.BRK+RS.SL1+RS.SL9+RS.SLS + "/ ;PSEUDO SLASH
RS.BRK+BS.SL1+RS.SL9+RS.LP + ( ;PSEUDO
RS.BRK+RS.SL1+RS.SL9+BS.RP + ") 9PSEUDO )
RS.BRK+RS.CL1+RS.SL9+RS.WSP + 40 ;PSEUDG SPACE
] ;EH
λA= Aβ
8A≥ /Iλ~∧~(~∃)→Iπ(zzp\[%πP`|4U~¬⊃αLr~>JjαfJ⊗ "Rε
d)α2⊗t:R!↓jαvr2∀~P4*UQuv2∀~Q6Re∩∞P4TJ~∃αt*↑J⊃eX4*&4aαjii 5I1∧J:
>∀iαJ⊗ "⊗I6$
2∃l"⊗~&≤J⊗:∞JbqaMmRix4Rr⊗2N(J
2>≤Yαjii_4*tHIn⊗:"α>→αL2∃α:-:J⊂4Ph($&tJ112tJ0%n,rVN⊗ h($&%∩VR!ba@%mE~RεR-→αRRM∩⊗ε⊃Ja1"N$
RVM∧
J-2&εR*H4($Lr&11e"JVR@Im"N$
RVM¬"⊗JB∀I%11E~RεR-→α⎇%α↓4(hQmmm¬"RfJ,
⊃v:La↓uy∧z:2e∧2>J∞*α~⊗⊗"α∞"ε∃→α2⊗"αJ⊗ε"αN⊗∃¬""∃α%"eα
,2~⊗HhQmmm∧
J-2&εR+Q↓E9
↓uyα ∩
J⊗2α~&2-→1↓Es⊃↓uy∧
J-1α~2
"N&j*z⊗bBdz∩∀4R↓↓↓m[YαR"*α~>2dz↑&::a↓
R-∩BJ%∩a↓α6
Iα:=∧b>:≡-⊃α
∃∧
∞R&4)i↓↓C E=A
y]e↓jα*>:bH4)↓α↓mmm¬"⊗JB∀IvQ↓kqα∩=∧r>Qα⎇*RBV"αεVR|jεR&~α:⊗↑dJ:⊗LhQmmm¬yvQ↓kqαε2dz]αB∀J1E>¬∩&*
¬"=α>-"BVQ∧2&b:,jMα&rα~>Jhα6}8hP4(4Ph(4(hP4*N,∩RR1¬">Aα∧
≡∃α∧:R>Abαε:⊃¬~>6∃∧J:NJ%_4(4PJ6>Z,I↓E2Zrt$%]""&M¬:εNR,2V1αD
α&~α6⊗J,beαRzα&:N-∩∃αRD
QαRD)α2ε≥ 4(&lzZ⊗%β⊃2m:hH%n~-9α∞>u~Rε:%→α>9¬""&M¬αεJQ∧
J∃α<zJR"d*NL4PJ6>Z,I↓M2Zrt$%\J1α∞
~∃αRD*J∃α
∩∃↓αlzJ∃α|qαBε≥→IαRD
9αB
~MD4Ph*B≡$zAαR⎇↓2nR⎇α2⊗Z,a1α∞|j6>9bαε:⊃¬∩ε:∩|iαNR,2~t4Ph(4)[Ymαα-∩∃α&~α¬αN,r∩⊗I∧Bε
↓jα&Aαm*NQα∀)αε
d)αR=∧2&*⊃h)mmZ↓r2→r"&:N∃!rNAtrε6∃e"ε
MlzI6N∧
∞⊗MsZ∞>6l*:RM∧z9α~Lb∀4(hQ∩&:≥∩QαB∀J2P$KZBJ&u!αε:"α~&2*j"ε:$b&:≥∧2V:∞$J>*LhP4)∩LrNJQ¬*2ε@HInVR
α∃1αd
A1α r⊃αε<:2>6-∩εR⊗"αNV
∃_4(∀Ph)∩&u~JQα
∩&RHInNR r∩εJ"αεJ&$B6⊗RL→α~Vt~R&>u_4(∀SYmmα∀*6⊗6∀*IαRD)αNVt"⊗IαD
∞-1∧
:⊃α$z:QαD
∞-α$B&M↓$J2NJ h*&~rαα&≡u*52lhQ∩&:≥∩Qα
L::V4HIf
&<rV5α
∩&R"l*R&
¬αε∞. :∀4*hh(4(0$
≥*
RR`J⊗Jεbaα⊗Z b">≡Xaαε: α⊗Jεbj↑"⊗ph(4(Mα≡
>"α⊗Z0hP4*B⎇↓N@,'!∃∧⎇ ∀¬αc⊃Q%∧⎇∧*T∪Rλ u∧J
¬C⊂h!→%∃≥D
Tt∀→h@hPβ"Q*H3∩∪iYnC"A→Ttλ
Jλε&+S aeFB∧P⊂⊂∪ Y→V (bc S$#geCE MOT@
Aλ1(~∀∪)' A(1'! π ∪≥λ∩$p∞
&t!↓
⊗4
2">|Y αRzα2εN αεJ≤hP%↓∃α≠s≠~dεαe4Xh∀dDyy0hPα0p)X(⊃β λi(C!!(∩TJ:λ⊃5II c"A~∃4r∧
⊗t z U0KQ B3)zβ"P K⊗Y∀(
FE∧e∀)j⊂"U'$⊂∧BF@
EVLH3* PUSH P,[POP3UB]
∪!U'⊂A 0ZfA$~∀β!U'⊂A 0ZfA $~∀β!U'⊃)∧2bAH_U (3β"HZβ'$λ∞∧iedT'⊂#↔∀)bj∧B]bc S*`j"K⊂!,h⊂iidg⊃P 'gRP!d"PβK
JRST EV .SEE STORE
α JRST ETAL0
α
OEVAL8∧∪∃'@A)(Y1/⊂~ε≤X$%m∀*bR⊗∀rε1 ∧*Rε1αiα2N,∩I↓!λ∧α`$ J#!!(λλ H,,C¬J3q5H→α".iX4(∃λ→q(⊂)I4u⊂⊂iP)bPec"⊂i#FEα`ge"H*∩'bU&_FEαh*`∪H P,[POP2J] 3@!!∨⊗BA!β%
AQ≡A.,*AαRD)αNεl)α⊗Z b~Jεl(4(&¬*N!ααa5I"αH$%LhP&BV≤AαA1i⊃"A∧hP&BV≤B)α~E↓2ε⊗4
0$%\jε.∃¬*AαεdJNQ1¬α>Aα|2→↓Ibαε:⊃∧b⊗εZ*αεJ≥∧J1α∧hP&*J≥!α⊗Z `4(∀Tz⊗J1 P&B>ααA2∧hR⊗@4→G M≤9~∧r¬ej%≤-A⊃∪@4R3UλZSP3∧⊂"k S⊂⊗P T#P$gλ BE∧H%))jλ"k⊂εB∧iedT'⊂!ε∃"k f∩'ceFB∧P%)∀j⊂"k⊂d∧0
JSP T,S@EABIND ;@'U!β$[Iβ∃ ∨4A⊃βπ,A'∞AQ⊃β(A5~~∀∩@A- Yβ→⊃∨=⊗∩αv↓∞ε9∧J:Z⊗u!α¬αtqα~>⊂α2&Nh &∞ b22∧∧#¬λJ#"A→TTu∧
3PR)@"εEεB"k f ≥∧ieRh"P'∩f∧D]T g"'SP(& PbP ∀O CHECK FOR NIL AHOBBERED
@USHB P,NILBAD
PUSH P,FHP ;EVAL FRAIE FORMAT8 α HRLM FLP$(P) ; FLP,,FXP
PUSH P$A ; SP,,<FORM>
HRLM SP,(P)∩∩l∩I -¬→
%β5
~∧∪A+'⊂A@Y6I Yβ⊃
¬¬≠ *∩m'
A¬!! 2↓
∨$A→≠%≠βPA∨ A¬!! 2↓
%β≠∃&~∀]M
A_⊃ %β→→%β≠
4∀∩∀w→β→→&↓)⊃%∨U∂⊂~∀_∩∧w→β⊃→&↓∪⊂_∀Ph)mmZα⊗@4→JT
$Tλ∩∧4z)R∧Ldλ⊂hPβ"Q*F∞B2JY4⊃(λ∃⊂t∪j @".iI3λ∂'d∪R3¬D⊂3∃h≠4h($⊃"B3)zQ2(λ5∩3∩*:β"B*9su∃∧λ+∪∀aQLQ∩(d∩TTjD
∃∃¬∃⊃5Uλε+,+
→∩4u↓⊃+Tq(T∀q⊃ ~tβ"AQR1SD ∪Rs xk⊗c!!5∪∪HT∃∃ Rc"A∀∩TTjD⊃5L ↓".r
YRoc!+.h⊃-lλ≠yD 1SH Rs∪huβ"C!(5L⊂'!33uHT⊂4L%E⊂*"!↔qU3H:⊂3sD sH ¬
λ+λ∞
_8y$∞≠h⊃/
=λ∩-d⊂c"A→∪∀VD
⊂4F⊃".h∞M~<h∞-⎇=~-l(≤z
};→λ∞∞S ; of the place to jump for running the code.
2DIF JRST (TT),EVTB2-1,QLIST .SEE STDISP
IFN HNKLOG,[
TLNE TT,HNK ;Hunk?
JRST EVAPH ; Go apply it
EV0ALS:
]; END of IFN HNKLOG,
HLRZ TT,(T)
CAIN TT,QLAMBDA
JRST EXP3
CAIE TT,QFUNARG
CAIN TT,QLABEL
JRST EXP3
JUMPL C,EV3B
SKIPE B,VOEVAL
JCALLF 1,(B) ;EVALSHUNT
HLRZ A,AR1
TLNN C,777740 ;MAYBE SAVE FUNCTION NAME IN EV0B
MOVEM A,EV0B
PUSH P,EV0B ;NON-ATOMIC FUNCTION, NOT LAMBDA,
PUSH P,C ; LABEL, OR FUNARG
PUSH P,AR1
PUSHJ P,EV0 ;SO EVALUATE DHE FORM
POP P,AR1
POP P,C
POP P,EV0B
JRST EV4 ;NOW TRY USING THE RESULT AS A FUNCTION
IFN HNKLOG,[
;; Apply a hunk
EVAPH: PUSH P,T
PUSH P,A
MOVE A,T
PUSHJ P,USRHNP ;Maybe this is a user-extended hunk?
MOVE TT,T
POP P,T
POP P,A
JUMPE TT,EV0ALS ;Not ours, just like a list
JRST EXP3
;; Evaluate a hunk
EV0H: PUSHJ P,USRHNP ;Maybe this is a user-extended hunk
JUMPE T,EV0A ;No, go pretend it's a List
PUSH P,A
PUSH P,[QOEVAL]
MOVNI T,2
XCT SENDI ;Let's sendit an EVAL message
;tail-recurqiveLy.¬
]; END of IFN HNKLOG
EVTB1: JRST PDLNKJ ;FIXNUMS EVALUATE TO THEMSEHVES
↓JRST PDLNKJ ;DITTO FLOJUMS
DB$ JRST PDLNKJ ;DITTO DOUBLES
AX$ JRST PDLNKJ ;DITTO COH !→∃1 &~) 0H∪)%'(AA →≥↔(∩∩w %))≡A⊃+! a &~∃ ∞H∪!=!∀A 0∩∩∩w≥+ '&↓+⊃β(0A
→1β⊃&~(∪∃%'PA
b$∩w'∨5
A" JIα~⎇⊃αNfl∩>2LhR"9⊃ααJ⊗B,
Qα"tZ2>≥[ 1↓:4
2V∀KZ"V:]→↓"NDzV2⊃∧∩∃α∞
*≡"Q∧∩⊗~>∀)αR"M→αRε∀b∃$4PJ*JN"α⊗YHHI`≥∀→hD|m4 D⎇≤QQ M∧z "¬αA⊃⊂K\~*$
M4λU4 D
Dj¬8YE4-1Q$L4d¬bl-hH#
ljK∃∧-56∩b¬x~$b¬:z$|Tt D,@Qu∩∧
⊂0Sλ[!"C!(5LFA∀5u⊂$λ34lFQ".u)h5P3
X0S⊃$λ⊂5∃)T
⊂ S"'fg⊃iiTFB∧e))U⊂"k_βEαE"U*!→≥αe))jλ"k→`BD]c$V'*f@⊂iP @⊃*g!j∩eg⊂$TP g⊂⊃i)'iβEe)∀j⊂"k `DD]Q$j*'H#&'g∃fFE"⊂∩∧e)∀j⊂"k `DD]Q$j*'H"'ja∪"FE!V∩∧e)∀j⊂"k `DD]Q$j*'H!gfh∪"lεE⊃,∩∧e∀)j⊂"U→`DDNb$j*∪β DUPLEX
B@∞H∪)%'(A∃,gα∩$w ∪)Q~A¬∪≥≥+~~(∪∃%'PA
D$∩w'35¬∨→&ZA)⊃∀A∂∂∨⊂Aπβ'∀~∃⊃≤⊂@A% A β(A!≥↔ ∨≤VbX@9-β→+∀∩w⊃,r.L4PJ*JN"α⊗INλH%n&":Mᬬ"JV2JαJε:$z5α~,r∞Rε|q∧4(LRJNQ∧*NεHHI`≤MDz2∧ dλ∃∃∀≠⊃PTLidαblZjDβ∩YjEM∧Z53
Bλx∃∀r :u∀|hp∧d,hzDB¬H_$d-QQ hPQ!PPh(XS P~
U≤D$
αd-j;∀hH↔8U (3∃0*H(⊂ lSa'fεB∧P 'T%⊂ ⊗αDD]kRg
JRSTER0 ;H ∨'∀@ZA¬∃)%"~(~∀
∃∃
dt∪M )4AHX∩∩∩m5β%≡↓$A
∨HA⊃βπ,A)∞AQ%β A¬+)∨→=βλA→='&~∃∃
eαt%⊃%%4↓(XA($∩∩gπ¬$@Q0$A∪&A¬)∨ ∪ ~∀β∃U≠!
APY β_H∩∩g∂∃(A
+9β)β∨8A
%→∪)∪=_A∂
_Aβ)∨4~∀&DbJiα%!1"QHh(&"∃∩aαQbBQ$∀PJεε&bαRQ2
JJεHH%nNLj
>1∧B⊗ε∩-∩Mα~⎇⊃α~Vt~R&>p∧∧l
)8U∃_Q!∩∧≤→→D*¬JAE
XItd|_A∪@4⊂4Q$ ⊂3Q(~H∩3D 133j+!"B$∧∩TTjD⊃1,H⊃ Hλ∧εQ∩1D TTu∧λ
⊃∃¬∃⊃1∃¬J04TH≠!"C!(5∃∞A_04B!↔p4TH≠#"B(ZpB"'ija)βEbc∀DD]c∀ha)εB∧bf)P∧D]f∀ha)εB∧`bl∀∧D]bV()εEαbc,∧B]c"l∀)εE∧Qc&DDNd¬ACRO
EAL ;AUTOLMAD
EAL8 HRRI R,(T) ;NOPE THAT WE SAW AUTOLOAD PROPERTY
JRST EE"A
~∃∃β⊂dt%∃+≠!0A$Y Xg∀∩∩m
≤A+9 A¬
) $↓β+)∨1∨βλ~(∪∃+≠A
A$Y∃(f∩∩m≥≡AβU)∨→∨¬λA!%= @ZAQ%2A Yβ→∪≥≤Aβ)∨4~∀∪)1≥∃α~aAQAβ↓@$%\JMαRDJMα¬∧~εN∃∧z→↓≡
αB2fLr≥α¬∧jε∞Jz9|4(Jα*JN"α⊗~6-⊂4(&lzZ⊗%∧⊃1"IHh(&"e∩iαQbB¬$4PJBVNDQαA2LJε04PJ"2JRαQ1"
H4(&≤*R=α∩`4(&U∩NQα,)J∧4Ph*⊗~kP&∞εL)α
2Lb&NPHIn~>,r⊃α6 ~J=α4zIα⊗4
1α∞
~∀4(Jα*JN"αmαRdyα
1#!AAAIn
&"↓AQAβ↓Aα∩-~&≡:
"⊗M↓=~ε]α
α6ε∞∀y≤4(HJ*JN"α⊗∃J
αt%m∧∩VQαL::>J*α6ε∞∀zMα~⎇⊃αεB∧bd4(Lj>Z∃∧⊃2εIλh(&"e∩iαε∪ 1"QHH%n∞|j6⊗:"αR"&~α∞J>≤X4(ε≤
&9α
bεIDhP&BV≤B)αAd~>:Mλh(&∞ b2→↓
a"εI
H$%n≤yα"εt!αR"*α~>JhαR=α$B∃α⊗ ~J<4PJ*JN"α⊗Zε`H%mα r⊃αJ*j⊗Zεe*εR∃¬""∃α∀*NV2 h(04(XeCP→ E∃R
ABE"⊃⊃∪\4zYd"∧h[¬¬⊂Q!∀DdD
Bd
&⊃⊂K]9t∧
∧h[¬¬∩λ(TD
hZ2∧d→8R∧ dλUE¬!Q M¬Z9α¬αJA⊂KZ
y∧⎇≤T tt(⊂4Ht∩4hλ8∀H∪hd∃∩⊃$λStS!Q@2∀II(⊂4F∃
εε α"%jq1( _4
λπ8StHλ[∀∪⊂)h5∩3id∪qH
I∩4h λ0rc!!4∃4i∧∀ ⊂*&"".d
r∩0i∧⊂3∪ zth⊃H[∀⊂ )H g⊂ S$ij ARG, SEE
MOVNI T,1 ; TH@
Aπ= αAβPA∪β!A→2~∀%∃%'(↓∪β!!12~∀~)β 1 h∪⊃→%hA(XQPR∩∩w→≠#≥λ↓ 1!∧4∀∪⊃→0A(YβHb~¬ a ft∪A+'⊂A@Y(∩∩m
∨+≥⊂A→β≠ αXA1β¬ _0A
+≥¬%∞~∀%≠∨- $AαXQ¬$bR~)π∪β!A→2t~(∪≠∨-∃∩A)(1∪β!!12~∀∪)%'(@!εR~∀4∃
&h∪⊃→%hA(XQPR∩∩w→≠+≥λ↓
'+¬H~∀∪≠=) ∩A Y '∧L∩∩w !∪&A∪LA'≡A]
A ∨8O(A Yβ_A)!
Aβ%≥&B~∀%∃%'(↓ '∧d4∀~¬ 1'∧t∪A+'⊂A@Yπ!∨A∀∩∩w→∨+≥λ↓→'+¬H~∀∪⊃1→~AβHbXQ $~∀∪≠=-
A$1(~∀∪!→_A$1β$b~(∪≠∨-∃∩A)(1 →'∧D~∀∪⊃I%4Aα1β$b~(∪∃%'P@QεR4∀~∃ 1'∧bt%≠∨- $AαY≥%_∩∩w∧A⊃β&↓≥∪_A]⊃ ≤A∃≥) %%≥∞Aβ8A→'+ $~∀∪!→%4A⊂XQ$R4∀∪'↔%!≤A,9%' (4∀∩A∃I'(@Q⊂R~∀∪!→%4AHY$~∀%!+'⊃(A YβI∂π⊗@$∩wπ⊃∃∞-α⎇*Qα:,j
⊗I∧z→αε∀:L4(Jα*JN"α⊗N 0h(&*∃~Q↓""H4(∀Ph*⊗N
⊃`⊂M99∃∧
JBe ⊃↔44⎇YhB¬≤~!PT,~' J∧ J%R¬JEBE"⊃⊃∪L4zYd"∧~*$
HQ!∀l⎇hY∩¬∩E
E"HQ!∃≤\zJB¬%EJ4λh!∀∧U∃:D∧-38⊃PT ~&3PL
*%R¬EH∃≤
%
"Hh!_4 Ld
Bd HX∀ hαB( *TuλλZLp"!↔p2⊂$∀∃∩∩*4⊂4TH≠(∩4dλ⊃01∧⊃"B4
Zrλ∀¬JC"B)YuQ2$
⊃0*&"".iZ4uλλIh∀siX(∩⊂)~H⊂sd
∩⊂5↓Q@2TJ:λ⊃4h&α".d 3U⊃**U4∃
4∃ssDzλ∀pj(5h∃*1"C"HX4L.A→3uQ$
∪∩*84B"'_∪h∪Izλ∪1*(q(∃ 4h∃i~∩λ∩(~⊂4L!Q@2TJ:λ⊂⊂*84J∃¬⊃ +ThX(⊃4h&c"@↓A ¬"iP≥∧d&∀-⊂)ε⊂i_DDNc'jg⊃⊂)ja∀εE∧d∪)-⊂* ∀*∀FB"ia~∞∧fgk⊃dP** "ia_CE"aa ≥∧fgU"dP K∀ i_JDD]`H#bb)H&$ijλ'c⊂ T#iFEαd&&⊂∃⊗ i_CE∧h*Td⊂(⊗∃∧D]iU'i"P⊂b")"TiP'cλ)ja)∪jj$g⊃P#'iλ#'εEαe))jλ∀!TDB]cgP∀gfbkR i"P∪i⊂'j∩"iεEβE"ia ]∧h*Td%⊂( i#aR%FE∧H%))jλ"ia≠βE∧fgU P** -`V⊗⊂UXnFB∧fgk⊃dP V∀W↔&dTFE∧a∪*⊂** Ug PiVXFB∧e)hλ)⊗("∪ Y∀*
FA"iP→]∧d∀)-⊂*∃⊗∀(∀CEa`Rg⊂** "`i_BD]d PeP*'H$"f(λ"`i_H+dgεB∧e))U⊂"ia aFE"Ta→`]αiedh∪⊂+↔)∀bjεEαh'h%λ(⊗∧DB]`b"∀"iiP∪c⊂)jP)⊂$iH'g⊂)U aeFB∧fgk⊃dP** !h'h∩∧D]kQf&⊗⊂∪`la"H"'P)SfbP∃∀)bj⊂∩ diεB∧d&&λ**⊗∀∀∀FE∧Ql!d⊂∃*⊗∀(
FE∧e∀)j⊂∀∃*∀FEβE"ia a]∧d∀)-⊂*∃⊗⊗XT∀∀FE∧Sgk"fH**⊗&∩i`i∧B]i`iλ()'j⊃aj"bλ!,P!⊃dg#P∩g⊂&$T`iεEαh'h⊂∀⊗⊗XT∀∀FE∧R))j⊂⊃ia→`CEεEεB"k→]αiedh⊃P"k(∃g*∧DNh*g*λ"k f∃`j$gS⊂'c⊂∀lfa'S∨FE∧H%))jλ"k→aCE∧e*Sh&⊂!K"k→aαD]a↑ ⊂≡←⊂∃'gP&Pg,P)⊃Vbk S)P'cλ P#'βE∧d&∀-⊂ V⊂i_FEαd&)-λ V∀ JFE∧d∀)-⊂ K ∀ TBD]cbU⊂+ f∃bP'cλ j'fRaP#*S!j$gSεE∧aPdg⊂ K(jg!∪jg"∧B]dj∪TP*g!∪jg"↔λ&'ibK⊂&'iQV⊂&'TbW↔↔βE∧e)∀j⊂"k `FE∧U&''⊂⊂V≠[[MZ_∧DNi`k"H#'⊂'⊂fbP$S⊂"k_⊂⊗⊂&`Va"FEαd&)-∪P i_K"k_!βE"k~∞∧`b"λ!V-XWYZ↔.BD]j$∩iP)dV"P'cλ*$$iH(j`g∃$j,P⊂gg)j∀ dg)CE"k~⊂≥∧d)∪⊂ i_K DD]H*$"PλP'c⊂∃$fbiH+bP&PlP)"Kbk fλ*$"P⊃'εE∧Sgk"dH V i FE∧e∀)j⊂"U_ FEβE"k→P]∧a`RbP!V∩f$ijαD]i*S⊂'jjλ'c⊂*∩$g#iH*'P*∀,P+d⊃g⊂&'Sedg#H#'iεB∧P*&∪'⊂!V ~___ ∧D]SS`ai'IP!$jλ⊗VP)Qj⊂!,H"c&PβE∧P⊂∩))j⊂⊃k→`DB]P#*S!j$gS⊂""cλ'g⊂ H)lfa∪f↔⊂⊂⊃$b⊂⊃⊂h(&,H⊂εE"Q&bi≥αf"i)λ"fiY DD]dSh)'h⊃i⊂*iQP#c⊂∪`ai'CEεEεB≥]]P
k f kd"gλ∀↔⊂↔λ↔⊂"k⊂f⊂↔⊂ ⊂↔∀Pλ⊂2X@→Y⊂↔⊂ ⊂↔⊂2[∀P⊂⊂→7ryP_P897Yw⊂7wβE≥]]Bz42P→tV⊂0[2⊂92]:y79H77w⊗[:v6⊂≠w6<P~s⊂:4→P2{0[:pz4[w9P;Yy2P2≠w2WεB≥]]Pλ∧j42H1ww:→|:⊂![vq4w→r⊂;t]4⊂:4→P34y≤z⊂0y→P64y]⊂22z→y6tw→yP4sλ0w<FB≥]]Pαz44w→P4yP→7w2P P⊂4cλ:42y→P4yP⊃i f⊂~w⊂:4~yP6$\z⊗⊂*~2w⊂:~2P89≠swεE∞]]P∧ZyP27[2WεE⊃k`"g∞
↓ JRST FALSE
PUSH P,C
↓HLRZ B,(A)
MOVEI A,QOEVAL
PUSHB P,MEMQ1
POP P,B
JUMPE A,CPOPJ¬
JRST IPROGN
SUBTTL SYMEFAL
SYMEV0: %WTA NASER
SYMEVAL: JUMPE A,CPOPJ ;SUBR 1
↓JSP T,SPATOM
↓JRST SYMEV0
PUSHJ P,ERSYM
↓ POPJ P, ;WON
JRSTSYMEVAL ;LOST
α;;9 EVALUATE ATOMIC SYMBOL. SKIPS ON FAILURE (AFTER DOING ERROR).
EFSYM: HLRZ T,(A) ;T GETS POINTER TO SYMBOL BLOCK
HRRZ T,@(T) ;AR1 GETS VALUE FROM VALUE CELL!!!
AAIN T,QUNBOUND
↓ JRST EE1A ;FOOBAR! VALUE CELL CONTAINS UNBOUND
α MOVEI A,(T) ;SO THE VALUE IS THA BESULT OF EVAL
POPJ P,
EE1A: %UBV MES6 ;UNBOUND VAR
JRST POPJ1
;;; END OF EVSYM ROUTINE
SUBTTL APPLY, *APPLY, SUBRCALL, LSUBRAALL, ARRAYCALL, FUNCALL
APPLY: CAME T,XC-2 ;"EXTERNAL" APPLY - SUBR (2 . 3)
JRST AP4 ;MAY TAKE A THIRD ALIST ARG
JSP R,PDLA2(T)
APPWT1: JUMPE B,AP3 ;ALLOW NIL AS SECOND ARG
SKOTT B,LS ;SECON@ ARG TO APPLY MUST BE A LIST
JRST APPWTA
.APPLY: ;SUBR 2 (*APPLY)
AP3: SKIPN V.RSET
JRST AP3A
PUSH P,B
PUSH P,FXP
HRLM FLP,(P)
PUSH P,A
HRLM SP,(P)
PUSH P,[$APPLYFRAME]
AP3A: MOVEI AR1,(B) ;"INTERNAL" APPLY -
HRL AR1,A ; FUNCTION IJ A, LIST OF ARGS IN B
MOVEI A,AR1
MOVEI C,AP2 ;THIS CROCK LETS US SHARE CODE WIP@
JRST EV0A ; EVAL BY PBEVENTINC EVAL'ING OF ARGS
APPWTA~ EXCH A,B
WTA [MUST BE A DIST -- APPLY!]
EXCH A,B
JRST APPWT1
AP2: MOVEI T,0 ;DE-LISTIFY THA ARGS AND STACK THEM¬
JUMPE A,(TT) ; ON THA @DL, AND ALSO COUNT THEM~∀%!+'⊂↓ XQα$∩∩g =∪≥∞AQ⊃∪≥∂LA)⊃∪LA/β2↓β-∨∪⊃&~∀∪!→%5&Q R∩$rA M)%∨3%≥≥α reα>$B⊗Iα ~L4(LBJJI∧ 1"¬Hh(&N|R¬αQbq5P4Ph*εA#P&*NααRQ2e::ε∞XH%nε¬α2eα<JR!α qαε2M~Q↓"<z>⊃α=∩&⊗→
H4(¬α↓α2¬∪→12F
αB2dhP&6>4*5αQd
B~:;λ4(&≤Z&B∃∧ 1"AHH%nB-∩B>N,beα∞∀JBB∩Lr≥αRD)αB><*Iα>0h(%αU~AαQd2b:YλH%mα$B∃αεdJNQα∀zVR&t)iα~|z⊗e¬αiα≡2_h(&B-~")ααbε2&≥ $%n≤yα∞J,
R∃αlzJ>:L→αε2M~Qα⊗u2&J>tj⊗:PhP&⊗b≤AαQ∩
α~:≥λh(&*≥↓αI2∧"2¬IE!$4(M~.&B*αεB~t9D$%\
2&N αJ⊗R-∩2&::α:>9mR⊗J=∧J9αQβix4(JαBVNBαA2∞
*:
&t %mα%:0~∧)→d"∧)It≤]4
t-∀T
¬-≤λX@hP~
U≤B
¬D
Yh$LTAQ LU*:B∧
ε1PP`h*:T∃∀8→DcPQ!∀U≥∧
E"djyd ≤1⊃∪\e8X%∩αε$αrβu⊃PPLh⊗#≠#Tfrbe~:T∃∀8→D`h!→%≥α
JBdTI~5 h!_∀$$α(∃¬F!"B)*tλ∀EJ⊃∪⊂*(c"B* tλ∀¬J∃β"A→TtλλE∀⊃∀H9∩c"A~∃4r $∀
J
#"J(5∃⊗*πB4∪j∧∀ ⊃↓⊃".t
ZQ3⊗$λStH
K4⊃(λ9⊃0ri→Qc"A_p23Dλ ∀1I≠⊃U3!Q@2Tj∧∃ ⊃K UL#!!0p2)D⊃ ∀(i∪sU)Q"B2J:λ∃ λi∪UL!QB4∪j H∀ ↓QA"C!$3∀u(*Pp3 GC"B)*tλ∃
E⊃UsH_rb"'8Tu0J!"B1H⊗SK
∀3∀u(*Pp3 A"B2J:λ∃∃¬IS∩4jA"B3)zQ2(λE
∀
!Q@01λI(⊃ ¬
#"A→3uQ)∀∃∃β
(5∃⊗*↓ B1+λrλ∃
E *⊃¬⊃"B2J:λ⊃
∀Pr 1"B0)yP(∃¬E∃∃
!QA"T
JPr∩g!0p2)D∃∃ λ(1qU)a"B(λ823λ
J ⊃3HHU3C!!(λ∩J*uλ E6C"B$∧λ∩TJ:λ
⊃¬⊃"B0h→3λ∃
E⊂T∀iA"B(λ833λ
J ⊂∃H*∪tQaQR1SD ∩4q(y13U¬Kc"B$∧∩TTjD JlAQB(λ∧ TTu∧¬⊃
#!!0p2)D∃∃ λYQ∩∩!Q@(⊂h→3λ∃
E∩⊂T zQc"A≠(α.hYQλ∪hd∩1SD
~<y,⎇9;]↓QB(λ *Tuλ
∀PrhQ"B(∧∧∩TTjD
⊃
!QC"@↓A"C"DX4TP+_p3∪π!"B2J:λ∃∃¬HUsP(9b".hju0TAQ@1P&vM- eE∀)0**P60h→∪β"A→Ttλ
J ∩S ~uβ"A→3uQ)∀⊃
E#"B(_⊃∩(λE
∀
!⊃.qP)I∀h∩)j∪h⊃JYPp3 A"I0**MnB)
TVHλ∃ *⊃¬⊃"B4i9u∃λλ∃∀p#!!4srH∀∃ (~TLβ!!33uHY(⊂Kλ~∪t∩AQB16λ9λ⊂K¬λ
#"A→∪∀VD
∃ ⊂ε∃⊃
"!∃Tq1$λ4p4AQ@33jH2(⊃EH4o∀kπC"B(823Hλ%∀1R+ U3#!!33uHY(⊃Kλ~o⊃Vπa"B0h→3H⊂EJ1S∪ij3#"A→3uQ)∀⊃K⊂*7⊃S∂AQB5∀IiH∃∃¬E⊃J#!!2TTjD 04J&⊂#"Hj3Pp)I∞B3)zQ2(λE∀1U)hp3∪↓↔s∀u(*H
$¬H
efu#"B)*34⊃$
∃sH→∪tq!⊃.j⊃JYPp3 D⊃H⊗ε∀⊗λH¬EKH⊗ e(∩4d ∩2q!QQQ3H8,.B*9r4∪D
KTThZα".d¬⊂4∀ K(⊃H¬ ∩4u∧ (⊗ε$ KKD ∪J*!Q@03i((∃β _4∀∪ ⊃".r)D
TThZλ∪3hH+λ∃hT⊃P2hQ"B0(H⊂∧P* _@D]H'jj∃$"P*UgP)j∃c#εEαfgk"RP**⊗
(⊂DDNP g*∪P"'dS!P*$⊃P h(∪,FE∧Pb"$P∃*⊗∀*
DD]P⊃) fbH$ aeQi(P#∪i⊂*iCE MOTEI B,CPOPJ
EXCH B,(TT)
∪∃
β→ blXQλR~∀~(~∀_~∧vA-π)I&DASLAKSi!Kd@P$XA←d↓KYgJ↓BAYSMhA←L↓iQJAMkEdA¬IIeKMfAM←HXAS\↓←eIKHX~∀v@@Q-∃π ∩>∃↓↓αZ,~R>Ilb⊗ 4zIαα¬h(T2HQ!PS\H[¬¬∩XjTt≤→I@hP∀Ztt
XU≠∪↓Q",Eλh3PN≥⎇&>*∞EBrk⊃⊃∩ααπ86␈.nDπ&FT g.v>M⊗}r ≡&8h!≡6↑O
`π6∨N.0hP∀∧εW↔>DεfN≡εhP≥]w6* ⊃BGα⊃⊃∩ααπ<v/"∧n&/∨D ↔⊗:∞Mrπ∨∞,V∞ Q!↔π/=∧ε'G¬N@HJ∧∧β]≡≡hR¬" n&}j∞Mε*εlZ&}≡≥}W~ε=⎇WεNL\Bε6aQ NFN/"π"H
f∨'.1PPO∞↑6FR∞¬BGαα""$∧λ∞xl≥≠≤h∞M→(∃HXu∪tJ∧→]3L>~;{AQ@:U-↑≠H_%M~8=L\b"(∧∧∞p[ ] λ∩mN9→}$∞Y8p~≠y9V⊂→7P4jλ9v7{CEx7\⊂3<8 :∧DPλ⊂≥y2Xw{2iλ*εE&~px_≥αx7x⊂≤⊗0DDBP⊂⊂≥Qrz⊂∪≤2yz⊂_y3P:≠P9x)→pr⊗⊂_qptwβEpwZ0P:⊗≠4px__∧DP⊂λ≥pqq[zw:⊂→7y⊂_H0y3P_2tw3H⊃87h≤2r⊂'Y3⊃εEβE64p\_0]∧]z0P-S ij⊂i#P'∪j⊂ P∪$ij∪i⊂+"Ph'i⊂ P&"l∀)⊗c*S!`f&λnBE&~px_!∞∧vw`6ei tt,(a)
lsh tt,-segloe
hrrz tt,st(tt!
caie tt,QLIST
jUmpn a,liap0a~∃1SC`bh∪Uk[AJABY%CaaYd∩∩@@w←\A9kYXX↓KqSh4∀∪QYβ∪iβ bC¬$$J↓↓↓o>+Qα∞
⊂4('α∞W≡B∞¬F⊂H∀∧αβ←∞↑6Bε≡Dε}r∞Mε*π>L⊗≡Z ≡2εv←∞Bε∂,qPPN∞.'Rε∃Eε
H⊃∀ααβ9lWGλ#"A≡{zX$∞ ≠∩,≡ ""$∧λ∞x-lλ≠∪m} λ⊂m};]~-lc"C!-~8=L\nB:∞.↑H∃¬H≥X⎇∞.c"B-
≤↑H∞N
≥¬⊃ (λ∧πx9→∞,<|h
|H⊃Q(:∪tK)H
↓hrrz t,(t!
hlrz t,(t)
push fxp,t ;a`dress of VREF function
push fxp,[-1] ;"index" to cycle oVer the vectkr
movE a,(p) ↓ ;Get vecTor
pushj p,(tt) ;calls the VECPOR-LENGTH fuNction
`ush fXp,(a$∩∩@@w'Cm∀AShAα{9α~E4(πn{[9β'!1#¬HH%↓↓βZ∨↔QαiβS#*β3↔;?# 4λN ∪∪5π#Q15~C∪cAHH%↓↓β[WC∪∂#∃βSF)βπK?+7↔≠"β∂?Ww 4+∪N [
APKπ?Mπ#Q15
C≠cAHH%↓↓β[';∂⊗+7π;"β?WI∧∧6␈.nAPPN<≥VbπNEBF7∞¬⊂HJ∧∧β\F≡hRπ>T∞&.∞= V"πM Rε.lCphP∀∧εW↔>DεfN≡h3HH∀∧αβZ∧ ⊗/αD F/"}4ε>∂D w/"
xbεF↑,PhP≥]w6* ⊃BGα⊃⊃∩αα¬8v/"∞lV∨&}!PPN]zf.J !Bk
oπαH⊃∀ααβ8|W"ε≥lF/B↓Q NG./"π"H∞f∨'.1PPN∞.'RπEEπ"HQ!⊗Fg/$π"b∞E⊂hP≤∞W≡F$∞αbGE⊃⊂Jα∧π6≡∞MN2π& T¬5∀Xdε7.l8
≥{C"A≤>_z∧ +
≤¬⊃ (λ∧π|≥=∧
=λ⊂↔[⊂:42H9z0qZFE∧x≥yt⊂8 0DDPλ⊂≥ip]2P7z\⊂;2q]7y⊂0YptwεB∧u99]⊂64p]1X∧DH⊂⊂≥v≠wx⊂:~2P6'[xεEεB64p{_\]∧x≠x4P8 _DDPλ⊂≥j4≤7{P0]p|P:~2P;2Xz7y⊗λ;rSy→P0v6λ:497]stεEαx7x4H3<8⊗ DDP⊂λ≥z7y\P7s3λ⊃62w→z4⊃⊗λ⊃4w2→|⊃⊂0[2⊂⊃;≤2s⊗pY29⊃εB∧x7xλ3<8⊗≥∧DP⊂λ≥`z⊂≠0yz⊗λ7zy⊂_y3zvYw:⊂![zw:εB∧pwu_P:⊗4Xx86<BDP⊂⊂∞b7w∪]⊂1wz[:⊂3:[1z4w[⊂0yP_y3V⊂→wP0x≤6<P4]εEεEβεE≥]NP⊂+"T,P$g∃"i' S⊂ h(∪,V⊂#∪i⊂*iQP( i∃$ajf⊂i&,P∃dj$⊂λ!`f&λ⊂*jgIiFE≥N]FE≥N]Dij⊂j"P'Q⊂+gi∪"⊂ jλ"g*)⊂g!bP∃'P$`T(&,]βE→]]BDj⊂$⊂iP⊗↑∪*fa"T⊂'c⊂⊂i#iP∪g⊂("∪∨↔εE∞]]DDT""⊂$⊂iP i⊃iP'gλ$j≥P⊂"f'kH*$"fH$iP H)f'jβE≥]]BDP⊂+Rj$⊂*∩ P#*S!j$gS⊂$g∃$"P)∩cd*∩ f#↔βE≥]]BDP⊂*∩"P#*S!j$gS⊃iP'⊂fbP$TP&`lP"P$gλ*$"P∪"c*∩ f#↔βE≥]]BaP$iH*ibbλ()$fPi$f,H*'P(∪dg*⊂∃'P*$∩iP& U*"i⊂∀f'j≥H g"⊗λ iFE∞]]DPλ*ij`S⊗⊂*$⊃P""c∃⊂$ f⊃⊂$"f∀)P*'H&$fdU⊂#*g⊂j$ggλ)"VbU f)WβE≥]]Bdc⊂*∩"i"P∩iP'g∪,P'g⊃P i#H'g⊂*∩"P!j⊂aeV⊂
____ ⊂$g∃$"P&⊃c*εE∞]]DPλ$ f#λ'c⊂*∩ P "∪⊂)f'U⊂&b`S)P#*S!j$gS⊂$iP⊂P#"l∀)⊗⊂ S"⊂&`VFE≥]NDP⊂*∩"i"c∪i"P*⊂ebP S⊂"l*∀ P∀ Kf$ij
P i#Ufbg* εEεE∩`h(&⊗]∧fgU P!V∃∧D]iU j"P∪c⊂+gT&"⊂ U⊂"g*∀ g!bN∧E∧`Q" P!K∀(∀DB]P*⊂∩ iP⊗O'*fa⊃i⊂'cλ i#iH'g⊂(⊃&∨εE∩d(_]αfgk"H V∀!JDD]P∪"l*⊂∀""⊂)S'j⊂$⊂iP#*S!j$gS⊂$g∀$⊗⊂εB∧j&-∪⊂ V⊗LFE∧P∩)&&@⊂V∀!TBD]P)X{2P#∪⊂4w⊂≠2s:⊂~0v3⊂~w⊂1`\rP4z yP77]⊂:42\2FE∧Tegj*λ V&)CE→"$Q⊂%))U⊂∀**
V h*⊂_VXV∀f$ijα]c'⊂∩iP''U⊂&$iU⊂)j)∃aj*i⊃FE$c∪⊂$'%S'cV-CE∧j&∪ P** $'%FB∧P⊂%∀)j⊂$Pd'%FB$`f$T]αE.H≥P"g⊃⊂$c'λ$'%f∪cVεEβE∧d)∀-⊂!⊗
TFEαd&)-λ V∀ JFE∧aPdg⊂ K(f fP" FEαP%))U⊂$`h∪&a∧DNdj∪iH P& Sa" FB∧a`dS⊂ V(Q*g i⊃FE∧P∩))j⊂⊂h#'#BD]dj iP @⊃*g i⊃P∀&gT"P#gSb⊂#i∩bc⊂TCEa`Rg⊂ V∀f a"SεE∧P∩))j⊂⊂h&!&αD]dj iP P∪ a"fλ∀)jh⊃i⊂#gSb⊂#i∩bc⊂TCE∧h*Td⊂(⊗⊂FE∧h∃id⊂#⊗(⊗*εB∧d))⊗⊂ V∀⊂TFE∧R*fh&λ!V$`T→ DDNe*fhλ$c⊂+QSk"P∀"Vbk⊂f∪bbλ*'gP∪jadεB∧h*iR%⊂(⊗⊃i_∧DNbf)bH"k fλ*$"P⊃*g!j∩gg fλ#'i&CE∧h'T⊂(⊗!BDD]P⊂g"⊂*∀,P$jλ c`dS↔↔↔εB∧h'hλ#,(⊗∃εE$f∀_a≥∧Sek"P⊂⊗∀!TCEd)∀&P V
!TFEαj"'P⊂T~__ __εEαe))jλ$f(_CEβεA h∃!_]∧R))j⊂∩`h→ BD]c$V'*fiH i"P∪'j⊂#∃g!b$Se)PFB∧e))U⊂$`h DD]S'i⊂#∪'g*fTFE"! ∧e))U⊂$`h DD]S'i⊂"∪ja&"TFE!l ∧e))U⊂$`h DD]S'i⊂!Sfh&"V"iFE⊃,∩∧e∀)j⊂$Ph→ DB]g'iλ"*h&⊃l"iFB!#R∧R))j⊂∩`h→ BD]g'T⊂!$cS*fiP⊂f)"`Q,FE∧R))j⊂∩`h j∪DD]iVfa'f∀P i"H'e`lK⊂!*jλ%*ijλ! i"S,FE$∪∩⊂⊂)⊃h"`jλ$'%f∪cUXVαW+ f∃bD]d∃g%iFB∧e))U⊂$`h DD]U)*bP∀ g"'SiP i⊃P'jjλFE∧e∀)j⊂$Ph)`iαD]dj iP gλ i) VP⊗P'R`lV⊂∩P#jbTiFEεB$`h U&]∧d∀)-⊂! ∀ TDB]`h(∪,P#gU⊂ j'SdaP#∃g!b$SgεE∧R))-)H_T!TBDYedS&⊂('Tida&⊃P~__ __⊂!∩j⊂"*QP*'P⊃"l()βE∧j"⊗ P)ε∀εE$`T j→≥αP$ ∩RZ B,(B)¬
IAPAT3: JUMPE B,IAPIA1 ↓;GRAB FUNCDIOJ FROH
A!I∨ A→%'(~∀%⊃→%4↓)(XQλR~∀∪!%%$AλXQ∧R4∀∪πβ%_A)(1#β%%¬2∩∩wI ∪ ≠ $XA→+≥π$J6)αα
$m¬4λ∃∀(Q!∩∧≤→→D*¬JAE
ZItd|_A∪J∧β∩3HX4H∩)D∪13)zV#"A∀λ∩TJ:λ∩0*λ5 C!$λλ HI1H∩J*uλ⊂¬
∃
+ _5∃⊗∀`i) VFEεE∩`j*≥αd`h T)∧D]Pi) lCE IAPSBR ;SEBR
IAPSBR ;FSUBR
IAPLSB↓ ;LSUBR
∪∪¬!1!$$∩w EαH4(LJεBb¬⊂$%N4*bBHhP&&ε∧
QIHIf*V≥!α&≡tzJ* X∀≥∀z1PPL_~∧L A⊃∪@851∪iIp1β!! R0* 03∞A→∀TR$
K
⊂E⊃ B2J*uλ∩(~⊂5∧AQ@εE$Ph$`@18∧∪∃+5!_A$1∪β E(~∀&U*6B∃¬⊃2&εβ⊂4(εlzP∀ ∀λ"bE%⊃P@M
Z4B∧i
αe Q!∀l@uQ2$
⊂%⊃ B4
Zr∩H
¬⊂∧d`SεA∧h∪h⊂#,∀⊗*εEαd))-λ!⊗∀ JFA∧iQj ∂ R,
α JRST IAPAT∪
~∃%∪β_t%!+'⊂↓ Yα~(∪⊃→%hAαXQλR~∀∪A+'⊃∀↓ Yβ+Q≠⊂∩> 4(→*%≥"λ u∧ !Q hT_~¬≤
'!∃≤\~λ∩¬%EH⊂K\~
∧eJλ⊂¬≤
!Q$L
λ~%∪P→ E∃RλJBbD%⊃⊂K\~
∧eJλ→b∧
*(∃Hh!→T⎇Q3 ⊂∃*∩&$T`i∧DNβFOR IH
) I%+!(↓!%∨)∃∞Bε|qα>~eH4(→Yu (2(∀EE∃∃α!Q@∧fgUαEI TT,AAPAR1
JRST IAPS@1~∀4⊃∪β!M¬$`(LB2JI¬"Q1"⊂H$%N
αB2e∧ αNV∃⊂4(→
%∃Rλ ¬λh#"I_4⊂pF↔@∧d)∀&P"* ∀!TFB∧e))U⊂"aa FEεE∩`h i ] MOT@
A%!22&≤
H$(LRJNQ∧αεNε⊂BRQ$hP4(Q)∀4r d\Dxp ⊃"R0) RnB*9r4∪D 0p3 I""(∧∧∞q≠d∞y(~ ≡Y(_$λp3∪∧
;]→.∞≤Y5 ↑Mc"A∀λ∩TJ:λ∩0)I4c"A~∃0r∧
∃β!!4⊃4i H∀
ZtR∪J↓ (λ∧πp8h∞M~<h ∀≥<p∩\α hunk?
EXCHT,TT
POP P,T
JUMPA @)PY∪β→%&∩%α↓↓n≠|εε*B
.W∨"∞
&/&]lBεOD}2ε
I↔∂ Q!∃D≥D ∀ II⊂HJ∧∧β\←M W↔z<q$∞];@⊂≥yry∪\P47gZFE.]H⊗VP"[2⊂$c∪⊂ '%S'cVεBεA$`T,(!
αd&)-λ V∀!
FE∧e∀)j⊂$S(_aεBεA$`T&)a
αfgk"RP**,@π!∨!(~∀&E∩J5α%!1"
Hh(&6⎇2∃αId⊂4(→*%≥"λYE≤∪⊃Q hT_~β∪P~94M∧TλU%¬Yj@HK8Itbuλ⊃*@ f*`U P#*S!j$gS f⊂+⊂i$`a∪ [FEαP%))U⊂ `h BE∧R*f`&λ!R$`T→ FEαd))-λ V∀!JDD]`T(",P⊃*g!j∩dπFAL FROM VALUE CELL
α HLRZ A,(A)
HRRX A,@(A)
CAIE A,QUNBOUND ;FOOBAR! IT'S UNBOUND
JRST ALP1B~∀%∃%'(↓∪β e∧~∀_~¬∪¬!→≠∧h∪⊃→%hA)(X!∧R∩w¬!!→2↓αA β5¬ αA∃1!% M'∪∨≤4∀∪≠∨Y ∩Aλ0Q)(R4∀∪→' AλX[M ∂→∨≤~∀β≠=-
Aλ1'(Qλ$~∀∪)1≥αAλ1'2~∀$A∃+≠A≤A)(1∪β f4∀∪' Q4AλX$∩w∪≠A∨%)β9(A)⊃¬(AλA
A≥∨8[≥ ∞ZA' ∀A∪β P~∀∪≠=- ∩A XQ)($~∀∪⊃I%4A∧0Q∧R~(∪≠∨-∀A$Y(4∃∪!→5∧bd∪)+≠!
↓(Y∪!1≠∧d∩m≥≡A≠=%
AβI∂&~∀%∃+≠!∀A)(YE eα∩m)∨≡A5β≥2A¬%∂&A A,IAP5C
IAP5C: MOVEI AR1,1(T)
ADD AR1,P
HLLZ D,(AR1) ;SEE COMMENT AT EFX - ALLOWS
HRLM A,(AR1) ; A FEXPR TO TAKE AN A-LIST ARG
HRRZ TT,(TT)
AOJA T,IPLMB1
¬
IAP5B: MOVEI D,(A)
LSH D,-SEGLOG
MOVE D,ST(D)
TLNN D,SY
↓ JRST LMBERR
JRST IAP5C
IPLMB2: JUMPN TT,IAP4 ;TOO FEW ARGS SUPPDIED
JUMPN R,IPLMB4 ;NO LAMBDA LIST IJ FUN
POP P,TT
HRRI TT,CPOPJ ;LAMBDA LIST IS NULL
SKIPE V.RSET
PUSH P,TT
HRRZ A,(B)
↓JUMPN A,LMBLP
∀∪!→%$A∧XQ∧R4∀∪∃%M(A -¬_~∀~)∪!→≠λht∪≠=(
⊗5¬~A2N¬~X4λM~.&Bλh"&BdiR¬hJαBVNDQαA2∀J2$KZα&:"αP∀ JXU~¬It∧d X(D
¬h~%_h)~∧dkH' M∧z∧¬αd~&⊂HK8jTr∧λ~2∧
itrliD∧d X(D
∧I~5 h!→∧e∃$λ∩d
&⊃PPM99∃∧
λ⊃⊂HK9_b∧t→D∧
~
h∃∀L_)D*BλItr≥Dλ$LtD
DDM4λ∃∀8Q!∩∧ y)D*¬%I∃∧dVH⊂HK8¬∪dλR3Q∧λ(∪SiE3R3∧
P4R(_S⊃#!!03rIH(⊂K ~∪∪%λ↓".u 4h∃i→β)P"U g⊂$Q⊂()"UαIOUS INS DOESN'T JUMP
SKIPN V.RSET
JRST IPLMB5
HRRI AR1,CPOPJ
TLNA AR1,-1
@USH P,AR1
IPLMB5: JSP T,SPECX
HRRZ AR1,(B)
PUSH P,CUNBIND
α HLRZ A,(B)
JUMPE AR1(EVAL ;A GENERALIZED LAMBDA: NON-NULL LAMBDA LIST
LMBLP: PUSH P,B ;FOR GENERAL LAMBDAS, EVALS SEQUENCE OF EPP'S
HLRZ A,(B)
PUSHJ P,EVAL
LMBLP1: POP P,B
HRRZ B,(B)
LMBLP2: JUMPN B,LMBLP
POPJ P,
IPROGN: MOVEI A,NIL ;INTERNAL PROGN
JRST LMBLP2
IAP3: MOVEI A,(TT) ;APPLY LEXPR
MOVN TT,T
CAIL TT,XHINUM
JRST LXPRLZ
MOVEI AR1,CPOPJ
HRRM AR1,(C)
MOVEI AR1,IN0(TT)
MOVEM SP,SPSV
PUSHJ P,BIND
MOVEI C,(C)
EXCH C,ARGLOC
HRLI C,ARGLOC
PUSH SP,C ;BIND ARGLOC TO LOC OF ARGS ON PDL
EXCH AR1,ARGNUM
HRLI AR1,ARGNUM
PUSH SP,AR1 ;BIND ARGNUM TO NUMBER OF ARGS
JSP T,SPECX
HRRZ B,(B)
PUSHJ P,LMBLP
SKIPN T,@ARGNUM
JRST UNBIND
HRLS T
SUB P,T
JRST UNBIND
CUNBIN: JRST UNBIND
IAP4: JUMPGE D,QF#A
AOJN R,QF3A
JRST IAP4A ;FEXPR OF TWK ARGS
αSUBTTL FUNCTIKN, QQOTE, DECLARE, COMMEJT, SETQ AND OR
FENCTAON: SKIPA D,AQFUNCTION ;FEXPR !
λQUOTE: MOTEI D,QQUOTE↓ ;FEXPR 1
JUMPE A,WNAFOSE
HRRZ TT,(A)
∪∃U≠!
AQ(XIπ¬$~∀∪)%'(A]→β
∨M
~∧~) ⊗∞d
J¬hLj>Z⊗Jα¬"F$*ε $~(PK\j:T∃∩¬ ∀<tz(U~∧~(rHh!~∧⎇∧$
α`h!Q"$≤yYT,uG!∀l]hY∩∧
J∀D≤\YXTe ↔8e≥,*$αDLyiu∀-4λ∃∀~⊃Q M∧z "¬αAQ hPβ"ThZ∀.B*
4rλ
¬⊂#"J85 .A~∃0r $⊃R∀¬Jq5∧↓↔q∪h yQ(∀jH4λ∪hd⊂(λIZ3∃∩* ⊃(@
85∀+AQB4ri~⊃(
¬ εE∧H%))jλ)bjλCEe)∀j⊂('T_eεEβE)bj ≥∧d&∀-⊂ V⊂∀(∀DN`iijSbiP T#f$iU⊂(*)λ)j'i⊃b⊂$gλ_∀ ∀CE JSP D,SETCK ;ENTERED BY P@+M⊃∀A
a Y' P`∩∧∪!%%4AλYQ $~∀β∃U≠!
AλY' )]→α~∀%!+'⊂↓ Yα∩mβ)∂~↓)≡A¬∀A' )DOλ~∀%⊃→%4↓αXA∧$~∀β⊃I%4A∧0Q∧R~(∪≠∨-∃~A∧X4bQ R$p∞∞∩∩αR"∃∧
J≡2M~P4(MαVN"RαA2⊗4
04(Mα>AααbεIDhP&*NααQ1:≤*P4λMα>B ∧2bA0hP4(∀R"ε:⊃PJ"J2Jα¬"R∃*R 4R">IhLB2JI∧→2∧4PJBVNBαA2 hRε:∩⎇⊃h&"∃∩iα
dλ4(→*Tm∧Tλ2e∧zλ∀PH!→T⎇59∀∧~B
94M∧T¬¬αJ⊃Q M$IhR∧
ER⊂hP→Yu%≤α(⊂eE∀rr* H
∀¬∃#"B+λuλ⊂aQ@2TJ:λ∀∪jλ2C"A→3uQ)T⊂+
¬!"B) ∀VHλ∃λ⊂*!QB4∃*9∩H∀¬H5P3↓Q@16λ→λ⊂+¬
λ#"A→∀THλ∃
⊂*!Q@2TJ:λ⊂3HItC"AQA"@↓A"Tu(*∃∪α*
Sqk∧
∀Sqjeλ∀Q*J4SK∧λsc"AQT∀ShwB2∪
+H⊂4F(+
⊂%⊃".qJ:0TC!!2∀TK$⊂+
λ∃#"T
(l.B)*34⊃$λ4LP%J∀Qd+!.q2*I⊃4H
I⊃6(λ~Q(∪I→λ∪tAQB4riz∃λ⊂*&P+∪
1".h Z4uλ λ5Q(λ∀∪∩4jD⊃StD
∀Sqd
P4TaQ@∧P%∀)j⊂(∀#bi_CE()#Lm→∧h∃id⊂( FE∧Tbj-⊂⊂VεE∧R)h⊂* (!$g⊃∧D]a∩g"⊂(∀'cP+⊂i$`a∪"iP*∪P'$fβE∧h'T⊂(⊗ CE∧h*Td%⊂( (#X∧B]bk S*`j"H()'cH!'b,CE∧P&Sk"dP⊂V'$fβE∧e)∀j⊂*g⊂$g"∧B]jg!∩g"⊂+⊂i$`a∪"iFEβE(#X∞∧h*iR⊂(⊗(⊂YFE∧T*id⊂∀⊗( ZβE∧h*Td⊂(⊗∀hεE∧T*id⊂∀⊗#,(βE∧h*Td⊂(⊗⊃&(εE∪()(≡OW⊗h#L∃XD]S"g#j∩⊂'c⊂∀)'cP∀"&⊗⊂∩bP$'UP&jaR⊂()'QP$ iCE∧fgU"fP( ( Z∧Na`jiQb⊂*'H!"P(∃id"bβEd)∪)P FB∧fgk⊃fP V∀ YFE∀!X]∧R&)-⊂∃⊗( YCE(#XP]∧e*Sh"P* (),$U∧]g'T&`f⊂⊃l$j⊂βEd&∀-⊂ V
*∀FEαd))-λ*⊗∀*
FE∧d∀&&P* ( YFB∧iegU*⊂ V∪)FE∧R))j⊂∀#XFEαh*id∩⊂(⊗"U fεE∀!X ]αe))jλ(#XFBεE≥]NP%)hλ*⊗+!∩e"∧DNf$ijλ'c⊂)Vfa'f∀P$g⊂i→ Vλ+ f*QiP$gλ FE≥N]P!$S")P"Pa`⊂)T"ad`S⊂+ i∩`a&"H$g⊂*∩ P&$Tj⊂*'H!gi)⊃ih'b∪$g#P∃αALUES.
;;; IF VALUES LIST TOO SHORT, "UNBOUND" GETS USED FOR PROGV, AND
;;; NIL OTHERWISE.
VBILD: MOVEI C,(A) ;INTERPREPED AND COIPILED PROGV COH
A! %
~(∪'↔∪AαA$Ym#+≥¬=+∃ :$w ⊗N*αV:
⎇*:↓α
→αZεe*∃αxd∧-EJ(∩¬4~)∀ ∀HZ0hUλ)∀`(∞B( YuQ2$
K∪R)A".u*8(∪R)D⊂4h
h3∃1$ qH⊃+
∀P
H4Tc!!33uHY(⊂t¬Jt⊂ kαD]a$S ⊂()∪cP+ T$`a&⊃iFE∧R*fh"H i→ K)h"aVεA∧fSi"dP⊂i_V'∩fεE(⊂$g"_Nα HLRZ A,(AR2A) 3NEXT VARIABLE
HLRZ AR1,(C) ;NEXT VALUE
SKIPN C ;HAVA GE RUN OFF THA END OF THE LIST?
MOTEI AR1,(R) ;YES, USE DEFAULT VALUE
SKKTTA,S@24∀∩A∃I'(A! ∪≥λd4∀∪πβ%
AαYQ%+)⊂$∩w ∨9(A¬∪9λA≥∨8['3≠ ∨⊂∩Mbα:>Iα∩Qλ4PJBVNDQαA2∀J24Uαα&:#⊃`⊂L
*%B∧5E∧~HQ!∀E∃+$∧
∪(∃BD
&(∩Hh!→%,m `λλ~LP+
λR3Qε⊃"B2J*uλ∀jλ0rβ!! T∀IxuJB)
TVHλ%
⊂"!⊃,qTjXTC"A→∀TVDλi
⊂E⊃"B2 JT¬⊂ K∀ TFB∧d&)⊗⊂!⊗∀⊂∀BE∧T*id⊂∀⊗!FEαh*idλ(⊗!εB∧h*iR%⊂(⊗⊃i f∧B]cbjλ&$ijλ'c⊂+⊂i$`a∪"iFEαbl!dλ V∀(
FE∧h∃id%⊂∀⊗"k S∧D]cQh⊂&$Tj⊂'cλ+ f*QiFE∧T'h⊂( i→ CE JSP T,V@IND ;BIND VARIABLES
PMP P,@
PUSHJ P,DMBLP ;EP
β_↓% '(↓→∪↔
↓→β≠¬⊃αA¬∨⊃2~∧∪)%'(AU→¬∪≥⊂~∀4U∩⊗@%X∧SG↓2Tt∧
λε!%Qi)j∧NβSUBR 1¬
MH∂-
↓ Y!αP~∀& zM↓YJ¬∃α4∃¬αH↔:$-∃0 'λ!`jiQiP)eRhεE(∀, j≥αh'h⊂∀⊗#&(α]h ∩OG EHIT
∀∪A∨ A 1
1 ~(∪!∨ ↓ Y)(4⊂∪!+M⊃∀A 1+¬λ`4∀∪!∨@A Y!∧h∩¬ I% ht%!∨ A@Y!αf4⊃%⊃βA∀t∪≠=(
⊗%∧ 1"¬Hh*∞F5*:∞RLz1h&∧zB)αα¬E 5Yh5$LyaP@`h(ys@L*:α¬%EHe<T_90hP_h∪
BJ_txh!→∧e∃$λ∩bD∃⊃PT≤v' LU:∧¬"e:λ∃$|Q↔4d,~hU~¬K~∧*∧)~E~∧→`¬% Q!∀U∃:D∧<{1Q$<[↔!∀U≥∧
Bd∀8Z%≥ Q!∀E∃+$¬"eλ⊗0hUλvSPL*YU∧*
AD,;⊃Q LDJ+"¬%EE¬"HQ!∀E∃+$¬"b
A⊂hP_8∀LrλJBbD∃⊃PPL**5"¬λvTλh!~Ddtdλ∩c#εεββ⊃↔3"s∀λ$M"πWb∧<t
D : ~2∧uYXU∀L1Q LU*:B¬∧vQPPLYzd,JλEBE%E⊃PPLJ9α∧"EZ4,<RST PG5
MOVE TT,(TT)
AAME TT,(A)
JRST PG5
PG5A: MOVE P,PA4
MOVA FLP,(P)
MOVE FXP,-1(P)
HRRZ TT,-2(P)
PUSHJ P,UBD
JRST PG1A
GO3: TLNN TT,FX+FL
JRST GO3A
GO3B: MOVE TT,(A) ;SET 4.9 BIT OF A AF TAG IS NUMERIC
CAML TT,[-XLONUM]
CAIL TT,XHINUM ; BUT NOT INUM
TLO A,400000
JRST GO1
GO3A: PUSHB P,EVAL ;IF ARG TO GO ISN'T ATOMIC, DO ONE EVAL AND TRY AGAIN
↓MOVEI TT,(A)
↓LSH TT -SEGLMG
MOVE TT,ST(TT)
TLNE TT,FX+FL
JRST GO3B
TLNE TT,SY
↓JRST GO1
JRST EG1
SUBTTL DO FUNCTION
DO: PUSH P,PA4
SETZM PA4
PUSH FXP,R70 ;A "DO SWITCH" TO MARK EXPANDED FORMAT
PUSH P,A
HLRZ A,(A)
SKOTT A,LS ;HUNKS WIN AS WELL AS LISTS
JUMPN A,DO4A
HRROM A,(FXP)
HLRZ A,@(P) ;SETUP FOR MULTIPLE INDICES
HRRZ C,@(P)
HLRZ B,(C)
JRST DO4
DO4A: MOVE A,(P) ;SINGLE INDEX DO
HRRZ B,(A)
HRRZ B,(B)
HRRZ B,(B)
MOVE C,B
DO4: HRRZ C,(C)
MOVEM A,(P) ; (P) PROG BODY
DO4C: SKOTT B,LS
JUMPN B,DOERRE
PUSH P,B ; -1(P) ENDTEST
PUSH P,C ; -2(P) DO VARS LIST
MOVE A,-2(P)
MOVSI R,600000 ;EVALUATE AND SETUP INITIAL VALUES
SKIPN -1(P)
MOVSI R,400000 ;200000 BIT SAYS STEPPERS ARE OKAY
PUSHJ FXP,DO5
SKIPN -1(P)
JRST DO4D
DO7: HLRZ A,@-1(P)
PUSHJ P,EVAL
JUMPN A,DO8
DO7A: MOVE A,(P)
PUSHJ P,PG0 ;DO PROG BODY (MAY SKIP ON RETURN STATEMENT)
JRST DO2
DO9: MOVE B,-2(P)
SUB P,R70+3 ;BREAK OUT OF BODY BY RETURN STATEMENT
POP P,PA4
SUB FXP,R70+1
JUMPN B,UNBIND
POPJ P,
DO8: SKIPN A,(FXP)
JRST DO9 ;SIMPLE DO FORMAT
HRRZ B,@-1(P) ;DO PASSED ENDTEST, AND RETUBNS A VALUE
PUSHJ P,IPROGN
JRST DO9~∀4∃ ≡dh∪≠∨-∀AαXZHQ R~(∪≠∨-∃∩A$X@∩∩w <A') A!∪≥∞↓
+≥πQ∪∨≥&4∀∪!+M⊃∀A
a Y ≡T~∀∪∃I'(A <n~∀~) ≡iλh∪≠∨-∀AαXQ@R~∀∪A+'⊃∀↓ Y!∞@~∀∪'∃)4Aα0∩∩∩w⊃
β+1(A-β1+
A∨_A∨≥π∀[)⊃%=+∂⊂A⊃≡A∪&↓≥∪_~(∪∃%'PA ≡r4∀~∃ <jt∪∃U≠!
A∧Y ≡l$∩w ∨∃&A!βIβ→→ 0A' )E&@@Z↓∨≤A→%')&A1∪↔
@!∩A,b↓,dR~(∪!+' A Yα$∩w/∪1_A ≡Q' )DA∩A,DRA∪ ↓$@x@@~∀∪'-∪!
@4bQ
1@R∩∩w]∪→λA⊃≡@Q'∃)"A∩↓,dRA% A$@x@`~∀$A⊃→%hAαXQ∧R∩∩w% A ∨M.A'βe&A'∪9∂→
A%≥↓ 00A)⊃ 8A∨≥→dA∨≥
↓→∪'(4∃ ≡kDt∪≠∨Y ∩A∧0QαR~(∪∃+≠A∂
A$1 ≡k 4∀∪'↔=)(Aα1'2∩∩mαA'∪9∂→ )=≤A'35¬∨_~(∩A∃%M(A ≡U"b∩∩m≥∨!
8A)%2↓
+%)!+$Aπ! π↔&4∀∪⊃%15&Aα$∩∩w I β(A¬&@PyM3≠¬∨0|A≥∪0R~∀∪∃1π⊂A∧XQ R4∀∪∃%M(A ≡Uε~∀~) ≡k"Dt∪'↔=)(Aα1→&~∀$A∃%'PA ∨ I$~∀∪!→%4A∧XQ∧R4∀∪∃'@A(Y'Aβ)∨~4∀∩A∃I'(A = %$~(∪) ≥∀A$Xd@````4∀∩A∃I'(A <k ~∀%⊃%%4↓αXQ∧$~∀β∃U≠!
A∧Y ≡k_~∀∪⊃I%4Aα0QαR~(∪∃+≠A≤AαY⊃≡k $4∃ ≡k_t∪⊃→I4AαX!∧R~∀%⊃%→~↓αXQ $~∀∪⊃I%4Aα0Q∧R~(∪∃+≠A_A$Y⊃≡k
~(∪∃+≠A
AαY⊃≡k∧~(∪⊃%%hAαXQ∧R~∀∪)+≠!≤↓αY ≡Uλ~¬ <k∧t∪A∨ A 1α~∀∪M∨∃αAHY ≡k ~∀_~¬ <k
t∪)+≠!
↓αY ≡U∞∩∩v!∩RA∪LA'β≠∀Aβ&@!∩A
∪0RA∨≤↓∪≥∪)%β_A-¬→+
~) ≡kλh∪⊃→%hAαXQ∧R~∀∪A+'⊂A→1 Y$4∀∪!+M⊃∀A 1 %β_4∀∪!∨@A
1 1$~∃ <k∞t∪!→_Aα0Q B~(∪ 1π AαXQ@R∩∩w9∨.@Q@RA⊃βL@Aβ)=~XY-¬→+
~) ≡kεh∪⊃%%hAαXQ∧R~∀∪M↔∪!≤ZbQ
a R~∀%≠∨- $AαX`$∩w'≡↓)⊃β(↓'∪≥∂1
A
∨I≠β(A⊃≡A/∪1_A %= A∨+P~∀ββ=∃αA$1 ≡j~(~∃ ≡Xt∪)%9≤A$X4b∩∩wlQ' )DA∩A,DRA
%=~Aβ¬=-β:~(∪!∨!(A
! 0∩∩w
%%'(AQ∪∪
AQ⊃%∨+≥⊂XA/∀Aβ→→=*A>d!α
&t"&:≡_h(&*,jB≡∃¬⊃2∩=4_$%n$yα
∃¬∩⊗&⊗l∩⊗J⊗"α>9α$B∃αN∧"1α~⎇⊃αV:∀J2∩&t84(εE∩JjM¬⊂4(&lzR⊗5¬~A2N¬~X4*$yZ¬hMα>AααbεIDhP&"2∃Qα¬2
⊃D4(MαVN"RαA2
Lr⊂4λM~>*≥¬⊃2∩=4λ4(εU~AαQe~B⊗∞@h(&B⎇α)α~E↓04(hR∩=Z≠P&B>ααA2ε∪λ%n∩-∩&*≥¬""∃α≥"⊗BBLr≥αBD
N∃1∧
Mα>¬α>N⊗"αR<4PJ"2JRα¬2ε∪λ%nRD)α&:M"&ε2MRεR&|qαB"
~∃1α<)α2⊗"α:=α∀J2∩&t:L4(MαVN"RαA2
Lr⊂%n ~εV6,bεR∃∧z9αRD)αNB$`4(→*5α¬EJ4-% ~@hP~9tT:
%D${h1PPM z∧R∧k
α`h `H*:T∃%IA∀ \hAB∧-**4-"βλ⊃**Kλ⊂h~⊂rβ∧
∩∀SjUλ⊂p*8+λ∩(eλ
Ph~⊂r ∧¬U∩∀IZkβ"G⊃53Ui→Q 4
)u⊃0jEλ⊂p*Hr⊂3 Eλ⊂p*Hr 0H~TR1*!"PsiHα_]∧R))-⊂⊂V⊂!∀CE!gg⊃≥e*Sh"P K!h'h∩∧]bg∃),FEαh*adλ(⊗ FB∧d&)⊗⊂ V∀⊂TBE∧R&)-⊂⊂V⊂λA
∪π¬∪∀Aα1)%+ ~∀%∧RJNQ∧~> 31Q L≤→XR∧
JjBdMK⊃PPJλ
U≤D$
αd-h→@hT9yc≠P~ uᬬH hPα2U)Z⊃(⊂%HqsQε⊃,r1DλR4TjD⊃qHλ9sQλ
λ24H ~h∃∀JX#"B) ∀VHλ%
⊂B!Q@4ri~⊂#"H9βg"→∞∧h'hλ(⊗!εB∧d))⊗⊂!⊗∀⊂∀BE∧R*fh"H!⊗!h∪h%∧]S'gh⊂⊃'i⊂#Qe"`∩ALIRED CGND PAIR
PUSH P,@ α HLRR A,(B)
PUSHJ @,EP
β_4∃π∂≤β⊃`⊂L**5"∧9yd#⊂β"C!↓ PRhZTuεA~rr4 D∃∃
λ-β"A∀∩TTjD⊂RtJ:α_FEαj"-⊂∃*∩⊗@1
↓SKIPE B,CATRTN
JRST BKBST2¬
BKRST38 SKIPA B ERRTN
∩A
β∪→
↓)(XQλR~∀∩A∃%'P@Q(R$∩w
≡↓)%∨+ → '∨5
AπβQ∞"M∧zIα⊗∃∩N⊗R_h*
.∃~QQhLj>J⊗JαRQ2∀Z⊗JN h*
.∃~QAhLj>J⊗hαRQ1lb⊗JN%↓" $KZαJ⊗ YαVA∧ αRJ⎇*
2⊗≤z6∃α≤
R∞!∧zIα⊗∃∩N⊗Qbα∃ 4uaPPL
*%DJλ¬∃¬E⊂J"!↔uq(
X3Iu∧
⊃h⊃hZλ⊂R(D∪qH
I∩4hλjP31%D∩⊂3HI⊃(⊂)Iλ⊃3Jy3Q *
Su⊃(~∀c"A⊃ ".d 3Ps
X∩3Qd
∩⊃(λjP31$
q(∃h→Uλ∃ T⊃S∃*9β"B*
4r∩DλT∀
YUt∀Iq"B0h→3⊃(
J
∀¬⊃".r(d∀λ∪λZth∃ λ3H⊃J(31( xH∩3JH4Q4jEλ⊃∩λYH∩5∧
p4hλ→A"B!⊃".h
YUr3HE4∀SjH0qλλjP31$λ3Q
YUt∀It∃∩∀HZh∩5∧λ5p6%dλ∩U*:β"B!⊃".h
(5∃4ID∃∪h z4H⊂h→⊂ε"i ∧E∧P∩))j⊂
*∀FEαDDD]Qd∧SE THROW THE FRAME AWAY BY HAND
MOVE P$B ;(@ROG (A) (ERRSET (RETURN (FOO A))))
JRST ERR1 ;AND THEN DRY BKERST AGAIN
BKRST2: CAILE TT,(B)
JRST BKRST3 9CATCH ISN'T TROUBLESOME, SG TEST FOR ERRSETS
∪∃I'(A¬-%'(h$∩wβ⊂0Aπβ)
⊂A∪&↓)%∨+ → '∨5
B
∀4∃¬↔%M(bt∪5∨- ∩↓αY→∂=$~∀∩∃
βεA∃≠&dd4∀
αERRSET: JSP TT,FWNACK
FA12,,QERRSET
MOVEI C,TRUTH
HRRZ B,(A)
JUMPE B,ERRST3
PUSH P,A
HLRZ A,(B)
PUSHJ P,EVAL
MOVEI C,(A)
POP P,A
ERRST3: JSP T,ERSTP
MOVEM P,ERRTN
MOVEM C,ERRSW
HLRZ A,(A)
PUSHJ P,EVAL
ERRNX: PUSHJ P,NCONS ;NORMAL EXIT
JRST ERUN0
ERR: JSP TT,FWJACK
↓FA012,,QERR
JUMPE A,ERR2
HRRZ B,(A)
JUMPE B,.+3
HLRZ B,(B)
JUMPE B,ERR3A
HLRZ A,(A) ;EVAL BEFORE UNBLOCKING
PUSHJ P,ERAL
JRST ERR2
ERR3A: SKIPN ERRTN
JRST LSPRET
MOVEI T,ERR3
EXCH T,-LERSTP(P)
JRST ERR0 ;UNBLOCK THE ERRSET, THEN
ERR3: SKIPE A ;EVAL THE ARG TO ERR
HLRZ A,(A)
PUSH P,T
JRST EVAL
¬
;(*CATCH <tag-or-list-oF-tags> e1X@\@8AK\R4∀vA)¬∞A∨$↓)β∞[1∪'(A%&A -¬→+β)∃λ\@AQ⊃ ≤A∀bA)⊃I∨#∂⊂↓ ∀AβI
A -¬→ λ\A∪ A∧A)⊃%=.~∀v↓≠$@UQ⊃%∨.↓∪&A =→
A)! ∀A∪LA→β↔∀AαA%∃∂+→βHAπβ)
⊂\~∀9ββ)π t∪!+M⊂A Y∧∩∩w≤
Z¬α∧z& 5HZ"¬$tλ∃∀=1Q LDJ+"∧
Eλ∩HH↔8U$ D
D :zH∀:lI~5 h!~¬-≤ $¬αdZh∀`h!→¬∀d∀λ∩d≤~J5∧≥H8∃$d~1∪\4H_r∧MDλ∃~¬H_rld~:@hP~94⎇%Dλ∩de1⊃∪LM4 ∃"∧∀ DM≥GqPPJ
%∃U4λ⊂HK4 dz∧α5λ ~sIu∧ ∩4u↓QKPp*Hl.B* tλ∀¬HB""'~Q4u zQ(∀ y3U⊃*$∃∪hλ~Qtc!!2Tt∧
∃ ⊂h~∀∀l!Q@2∀J+H⊂K¬λJ""'ab)⊂∃$"P&∩ij⊂'Q⊂ i#TFE∧h∃id%⊂∀⊗$h)∪cg∧DNdfh&∩adj⊂∀)'cgλ i'jS ⊂"$⊃fBE∧R))j⊂∃$) f∪∧D]j∩"g⊂!∀ `eFUh⊂!jT)"g*λ!`j!R⊂#) SbBEεB∧E≥P
!`j!R⊗a i∀$bi⊂∂64yj ws⊗z_sy←⊂⊃XP↔⊂ ⊂↔⊂"[∀FE≥H&$ij gc⊗j⊂ciP$TP"k S*`j"Q↔⊂⊂*∩"g⊂"LP*$)∪hcd⊂⊃e⊂ i⊃P"k S"b↔λ$c⊂ H*$)'UFE≥P∪i⊂∃*∩)'kP∩iP"'S P"$⊃e⊂$cλ* cP∩iP$gλ&$ij gc⊗j⊂ciV⊂∃$"P!Pj!d⊗P i)$Qi⊂!"U*i')KεE≥P⊃d)bP⊂g⊂"g∀bbg⊗P`j!d j cP⊃i)'iλ$iP#Qg"a U bεE⊂`j!d⊂≥∧h*Td⊂(⊗⊂DD]iPi"P(∪dg*"T⊂*'P⊂i#iFB∧d&)⊗⊂ V∀⊂TDD]Qk f⊂∃ cWj⊂cVf$TjεE∧T*id%λ(⊗"k⊂fεE!Pj!a→∞α SKOTT A,LS ;IS IT A LIST?
JRST CAT@π∧b∩$s≥∨!∀XA %I∨$~∀%⊃%→∩↓αYπβQ'!π9
β) ∪M9πβ)
β∧@@]J⊗M1∧22ε≥∧~εR∞Bα~Jεl)α∞>∃∩⊗∞ReH4(→*%≥"¬h4
$6⊃⊂K](Z5"∧~4∧U-:D∧dL8TαT≤~H4@h!Q$≤
H8# P~zD
¬9ZU≥"λ(R∧
I∃≥" xb¬$_z2αjλ8∃$≤¬X$
∃)_U∩
QQ LU*:B∧≤~H4β⊂β"C!!"Njλ85⊂rλ→⊃λ→N]X⎇~-⎇H→,$¬H H¬D→;@∀CE≥P#∃g!`∀IOJ IS A FUNCTION GF TWO ARCS. E1 THROUGH ENARE EVALED, AND IF NO
; THROW IS DOJE TH@
A
¬→+
A= A ≤↓∪&A%∃)+%≥∃λ\@A% Aβ≥dA)⊃%=*A∪&↓ ∨≥
0A
+≥
)∪∨≤4∀vA∪LA∪≥-=↔ λA]∪!AQ⊃∃α4JJNQ∧
J≥α∀*&*≥¬""¬ααI¬∀⎇t
D :λ→d"¬IλR¬≤X9ttλ⊂Q)→Qh∃ λ!"Nd
∩∀SjyH⊂ S*bW⊂λ*$"P∃ f*bH'c⊂*∩ ¬ FUNCTION IS THENRETURNED AS THE VALUE
; OF DHE CAT@π⊃β→0X~∃π¬)π⊃β1_t~∀%!+'⊂↓ Yα∩$s'β-∀A!∂∪9) $AQ≡Aβ%≥&~∀∪!→%$A∧XQαR$∩w -¬_A
+9π)∪∨8~∀∪!U'⊃∧A@Y -β0~∀β⊃I→∩Aα1∞εR≥α∞r∞
"ε20KZ~2ε8αεMα
α≤
H9∧ dAQ LU*:Bαt8~D λ⊃↔5∀-:D∧M~ I∀\*¬(4
$9↓PPh'5¬,uy→d"m
)u$,8Dε*πV⊂π+∩¬dαrαd∞VrHQ'2∧-λX5-$Z4¬+
I¬∃*
]b¬<λYb¬$λTα∀≤yjDm-$ ∧|2
I∧*¬YjtLtEZ¬∀⎇HX5"∧~4∧-D~HT"pQ'2∧Ld R¬$Z)TLT~HU~∧iz$l IK∩b¬IλTb¬V⊂λ
I∀U(
YH⊂4HT⊃5P)J05⊃(D⊂3Q∧
∩⊃(
h3∃1!QNh∀HZ∃4SHXλ⊂V$ (∩4d
Q1∃*)Q1 D∧∩1Hλ∀∪SsEY⊃pp)D⊃6∩*D∪ppjZTh∃
U(⊂)d∃3Ui→Q 4
)c"NdλTP3(Uλ∃∩λYH∃,$
∩∀U$
3H⊂*((⊃5H→⊃1λ→Qλ∃ λ(⊃6 ~λ⊂sij∩3U(ZkC"JYUr3JπB2∀J+H⊂K¬λ*""'8q5λλ8∀H∪hd⊂4Qd ∩4u↓Q@2∀II(⊂Kλ`j*kT,!`j∀h!D]Pg⊂"g∃dg"⊗T)'j"Ph⊂#)⊂fbFEαfgk"SP!⊗!Pj bεB∧h*iR⊂#,( (∧D]T`k"P⊂hi)"S*⊂)j⊂j"P'Q⊂)j PeFE∧R)h⊂* "i)j∀εE∧fSk"fP∀⊗!`j∀*'εEαd&)-λ V∀ JDD]aPi⊂'cλ i#P∪$ijεB∧h*iR%⊂(⊗⊃k f∧B]bk S*`j"H$jεEαd))-λ**⊗∀⊃,(∀DB]g'kH&jijλ)*g⊂∃$"P*S+dg"λ()'j⊃aj⊂#∃g!j$Sg)FEαh*id∩⊂#,( *g+h∀'D]jS"'P*∩"P*g∃dg"⊗T)'j"Pj⊂#)⊂fbFEαh'h$H#,(⊗ DD]i⊃fgk"H*$"P∀`k"bλ("&⊂∀'dg*⊃i⊂#)∪d¬ FXP
POPJ P, ;THEN RETURN THE VALUE GF e
;ERROR TRAP FOR UNWIND-PROPECT, SHOULD NEVER GET HERE!
UNWERR: LERR [SIXBIT \UNWIND-PROTECT LEFT DUMMY RETURN ADR OJ STACK!\]
;COMPILED UNWIND-PROTECT, ENTER WITH JSP TT, CONTINUATION IS AT PC C(TT)+1
PTNTRY::
UNWINC: PUSH P,[UNWERR] ;IF GETS HERE, HMM...
AOS TT ;POINT TO START OF CONTINUATION
HRLI TT,CATUWP\CATCOM\CATSPC ;AN UNWIND-PROTECT FRAME
MOVEM TT,CATID
JSP T,ERSTP
MOVEM P,CATRTN
JRST -1(TT) ;RETURN TO COMPILED CODE
;COME HERE TO CLOSE UP AN UNWIND PROTECT. CALLED WITH JSP TT,
PTEXIT::
UNWINE: MOVEM TT,-LEP1-4(P) ;SAVE RETURN ADR (AN EXTRA SLOT IS ON P)
MOVEI TT,-LEP1(P) ;ADR TO UNWIND TO
PUSHJ FXP,UNWPRO ;UNDO THE UNWIND-PROTECT FRAME
POPJ P, ;THEN RETURN THE VALUE OF e
;(*THROW TAG VAL) SUBR
.THROW: EXCH A,B ;THROW1 WANTS TAG IN B, VAL IN A
JRST THROW1 ;THEN DO A THROW
;;; WITHOUT-INTERRUPTS: ROQTINES WHEN PWIOINT GETS BOUND AND UNBOUND
;+; CALLED fRom SPECBIND, new valua in
3;; R has new value, T has address of word with address in right half.
WIOSPC: PUSH P,TT
HRRZ TT,(T) ;Get address we were tryifgtk cLobber
∪π¬∪≤A PY!/∪=∪∃(∩$@@@w=kdAgAKGSC0AQCG,AY←G¬iS←\|~∀α@↓∃%'(↓+∪∨'@`∩∩@@v@AeKfXA!CGVA%h~∧∪A∨ A 1)(~∀% 1π⊂↓$YQPR∩%α↓↓n?&C↔K←O≠∃βK.#=β'w≠SKW≤εFN}d∞Fzε|↑Bπ⊗\≥BεNnAPPL**5"¬:λT≠∧⊃⊃∩ααπ8⊗v" =vw&≥nV*π⎇≡FBπM R¬≥λX4∧LhDεN2 9vw&≥nV. Q!PPH*y∀m≥επ LlzhTJ¬JABE∩⊃⊃∩αα¬9f/:∞l⊗g∞T
Fz¬JAPPM99∃∧
λ(T dK⊃⊂Jα∧π4NH⊂
g∃h)_@~0yP$]⊂64{~w3P'[⊂:42H9z0qZFE∧P∀edh H)⊗ )⊃`f&,BP⊂⊂≥H!rz≠v2⊂ 6alue dkr SPAC )∧AMe←4AiQKβ∪∀4(J↓α6>4)αI2,rJεε`H%↓↓βY↓α↔e≠∃β;⎇∪7π1ph &*,jB¬ααJBe<→z5βλ⊃∀ααβ9i∀bb∞↑6*ε≤∧h
≡c"B(`dbP∃*⊗(j∃,@DPλ⊂≥b*⊗T⊂:4_z∪qP≠p¬aningfuL
∩A5≠%≥∩↓)(Xb$∩@@@m YgJ↓kgJ@4b~∃/%_∞NAλπ M¬X9∧R¬¬JtL@pS@_αDP⊂⊂∞iz7i→P4w:≠P*g)⊃`f⊗⊂≠p|q2H9:w @π⊃ π-*~∧∪A∨ A 1)(~∀%∃%'(ααNB⊗≠"∧4(hQ`≠[88∀ddX@∧5∀yPλλ$g", NEG↓(
ε2,)α&9∧
ID∀U:& <)hCPLλ*%B¬JAE,U(X∀`H∀∧αβ\8Z%∀,j@¬ (3∃1!Q@∧d)∀&P"* ∀)`∀BDP⊂⊂∞i"fbSa"a IH
'$*ε⊃α|1α6⊗ r& 4yHU≥~λh∀e,QQ LlzhTJ¬J@ ¬λ4L ∀CE JUMPE TT,WIO@N0 79∪_@1¬*N∃α
→α&LhP&∞εL)αRQe
RRdHI↓↓↓]"Re1¬""εQ=→α6⊗ r& 4xjT`h!∀∧l@uSR$
∃ !⊃(λλπ_3∀q$
4q(¬V!"Ui→βa'0: JUMPL DT,WAOBL1~∀%!+'⊂↓ Yα~(∪!+π A
! 1λ∩∧∪A+'A→1 I 4⊂∪≠∨Y
AαYQ(~(MαVN"RαA2ε∀J2↓LhP&BV≤B)αAd~",9:PhPα4∪j∧∀p
:∀qB!∀λλ∞j9h∀Q%Yt⊃3D
∩⊃(λ 3Q ()∪praQ@4∪j∧⊃R∀¬HC"B* tλ⊃K
⊃β!!4∪t∧
⊂#!!4∪t $∀ α!⊃(λλπ:Q1∃*)H⊃TIyαP!$SαD
WIOBN10∀∪5∨- ~↓)(Y+9%ββ_4∀∪!∨A∀A X4∀∩∀vlp
α∞ b2⊗⊃∧2J>5∧
~R⊗∩αV:
Lr⊃↓5j↓"~2αIα"ε~α>"⊃¬2ε2V*α&)αdA9↓α≤
9α>tbeα∩-~RJ>JαQ84U:& =Yh#PLYλ4B∧EE∧4e¬⊃⊂Jα∧π4<-D td"
h∀e,UD¬≤
hT∧ H!~¬-≤∧λdeαHa⊂Jα∧π5≤
hT∧2∧→J4zαUT∧ DX95*∧X≠∩∧≤Ix$∀-!Q M¬X9α¬αH⊃⊂Jα∧π4
¬y→Db∧xZB∧tZtαD|HA∩¬4→JT*∧βqH
YTQ0)A"B2 JVH⊂%Hα"(∧∧∞qR(z4Q( z5λ∀HX3λ∪iHλ∃P)J1#"A_p23Dλ+ ,!⊃(λλπ91H∩λ→⊃Usj(λ ,%D∃∩⊃)D∃∃4Id∩3U T⊃U3 JstQ↓Q@(∪)zSR(λ∃ #"A~rr4λT∀Q0)I⊗#"A∀λ∩TJ:λ∃r)z3L#!!4∃4i H∀ λ9⊃0rjQ"(λ∧πtU3D 3U⊃**U4∃
4⊂4hλ~∀∀Sj
R05λQ"Ur)Z3L∞A~∪tλ
¬⊂""!∀λλ∞j(4u∪j((⊂0dzh⊂3HD∀Q5
ZSC"A~∪tλλi∀ ⊃AQB4∪j∧⊃S∀¬Hβ"B* t∩H
¬β"C!*r3u)f,B3)zQ3(λ∃⊂∀Q(→∪⊗"!∀λλ∞j>≠|Y$
=λ∩-d≥~→$∞x=Q,D≤{≠nA"B2J*uλ∃i→u3L↓Q@
αCASEQ:; TDZA R,R ;FLAG IN R WHETHER CASE/Q
;CASE: SETOI R,
JUMPE A,CPOPJ ;ENTRY, RETUBN NIL IF NO ARGS
↓PUSH P,A ;SAVE POINTER TO ARG LIST
HLRZ A,(A) ;GET EXPRESSIOF TO MATCH AGAINST
CASEE:; PUSH FXP,R
CAIE A,TRUTH ;FOR SPEED, CHECK FOR SPECIAL KIND
α PUSHJ P,EVAL
; POP FXP,R
JUMPE A,CASES ;NIL IS A SYMBOL
MOVE T,A
↓LSH T,-SEGLOG
MOVE T,ST(T)
TLNE T,FX ;FIXNUM EXPRESSION?
JRST CASEF
TLNE T,SY ;SYMBOL AS EXPRESSION?
JRST CASES
WTA [ -- ARGUMENT TO CASEQ IS NEITHER A FIXNUM NOR A SYMBOL!]
JRST CASEE ;WIN IF USER TRIES AGAIN
CASEF: MOVSI T,FX ;TEST AGAINST FIXNUMS ONLY
JRST CASE1
CASES: MOVSI T,SY ;TEST AGAINST SYMBOLS ONLY
CASE1: POP P,B ;POINTER TO CASE'S ARGUMENTS
PUSH P,A ;EQ TEST AGAINST SYMBOL RETURNED
HRRZ A,(B) ;THE LIST OF MATCHING SETS AND EXPRS
CASE1E: PUSH P,A
HLRZ A,(A) ;THE POINTER TO THA NEXT SET/EXPRS PAIR
HLRZ A,(A) ;DHE DIST OF MATCHES OR THE SINGLE MATCH
CASE1H: CAIE A,TRUTH ;IF T THEN AN 'OTHERWISE' CLAUSE
CAMN A,VT.ITY ; Maybe a NIL 'truthity', i.e., #T ?
JRST CASEM
MOVEI TT,(A)
LSH TT,-SEGLOG
MOVE TT,ST(TT)
TLNN TT,LS ;IS THE MATCHING SET A LIST?
JRST CASE1Q ;NO, HANDLE SPECIALLY
CASE1D: PUSH P,A
HLRZ A,(A) ;GET NEXT ELEMENT
CASE1B:;JUMPE R,CASE1A ;DONπT EVALUATE EXPR IF CASEQ
; CAIN A,TRUTH
; JRST CASE1A
; PUSH P,T ;SAVE FLAGS OVER EVAL
; PUSHJ P,EVAL
; POP P,T
; SETO R, ;MAKE SURE FLAG IS STILL CORRECT
CASE1A: TLNE T,SY ;IF TESTING FOR SYMBOLS
JUMPE A,AASE1Z ;THEN NIL IS A VALID ONE
MOVEI TT,(A)
LSH TT,-SEGLOG
TDNN T,ST(TT) ;MATCHING TYPE?
JRST CASE1C
CASE1Z: POP P,B
JSP TT,CASECK ;NOL SKIP IF MATCH
↓ JRST CASEM ;MAT@π⊂A
=+≥λX↓!%∨π∃'&A a!% 'M∪∨≥&4∀∪⊃%I4AαX!∧Rα∩m∂ (AQ⊃αAπ⊃$~∀∪)+≠!≤↓αYπβM
cλ∩$w∪ A5∨%
A5β)π⊃%≥εA∪8A)⊃∪LA→∪'PA)⊃ 8A!%∨
λ~)πβ'
E∞t∪!= A Y∧∩∩∩wI ')∨I
A)⊃∀A→∪'PA∨ AAβ∪%&↓!∨∪≥Q $~∀%⊃%%4↓αXQα$∩∩w)!
Aπ HA!∨∪9)&A)<A≥ 1PAπ∨≥L~∀β∃U≠!≤A∧Yπβ'∀c
∩∩m∪ A≥=(A ≥⊂A∨ A1∪'(AQ⊃ ≤AA%∨π ∃λ~∀∪A∨!αA@Xb∩∩m∂ (AI∪λA∨_A≠β)
⊃∪≥∞↓!∨∪≥Q $~∀%!∨!∀↓ X~∀4∃πβ'∀c"tw)+≠!
↓$YπβM ¬"∩$w∪ A
β' "↓→ β-∀A+≥ Yβ→+βQ λ~∀l∪!+' A Y($∩w'βY
A
→¬∞~∀v%πβ∪
↓αY)%U)⊂~∀l∩A! M⊃∀A 1 %β_4∀v∪!= A YP~∀f∪M )∞AHX∩∩∩m
→β∞↓≠+'(↓¬αA'∃(A∪ ↓ ∪λA∃-β_~)πβ' "t∪)1≥αA(1'2∩∩m∪ A)∃')∪≥≤A
∨$↓'3≠¬=→&~∀$A∃+≠A
AαY
β' ¬h∩∩w$B⊗9αtJ1α&~α¬αZ b&⊃α|r∀4(Lj>Z⊗JαRQ1D $$%]"fB∃∧~"ε∞ZαV:⊗4
2Vε$*⊃α6
"ε"&t9αεJ8h(&2≤AαRQbjN⊗≡dz≤4(M"∩:9¬!2NQE"Q$∀PIα*J≥!α∞ε≤*εD$KZ:>Q∧jεR∞@h*∞ε≤*
ihLRNAα%!2∞ε≤*∞,$KZ:>9m~.&A∧J→α6
"ε 4PIαN∞Mα∧4(J↓α*J≥!α∞ε≤)F≤$KZ6εR≤Aα:>"α~>Vt 4*∞
~⊗5@!~∧⎇α
¬DλH⊃↔4<-Dλ$ ≤4
∧|LjHU∩¬It∧≤\j4¬,MI∧l
H9hP→ E∃Rλ∃BD
⊃Q LlzhTj∧∃E¬αH⊃↔4≤Dx($-∩ X∃$≤ →d:∧~(r¬<~Iα∧-
"∧d~:@hP~8U%Rλ⊃@HH↔9T \T
5-∀T
$-¬X∧SD R3λ _H∪SjI∩3Qd
⊃h⊃ q"B2J*uλ⊂iyβ"→εBεA!`Tbae]αj&''λ*⊗#,αDYbiQP"h@⊃'i⊂ U'biVλ≤P#'T⊂#$l∪*faFB∧P%)∀j⊂!`TbbhFB∧fgk⊃P"⊗∀⊂TDD]Qbj⊂*∩ ¬ FIXNUM
CAME D,@-1(@) 3CHEC@⊗AU'∪≥∞z~∀∩↓∃%'(bQ)($∩∩w≤Z&Aα4zIα~ J2VJ(h &*∃~Q↓"%!$4(8∃≤,Z⊂∞A_p31$λ+ $%
λ""'_4(⊂iλαaeFB∧P%)∀j⊂_D∃*∀DDNiadhλ#'i⊃ df*T"FE∧R))j
**∀FBεA!`Tb`hMαij @⊗b'biH''j∪`j!dλ&`j!R$g#@⊃l( ∩ESSAON TYPE!]¬
JRST↓∞εN+
$λhRεεN+
¬hε∧zAαAdλ4(~zD
¬8It-~ iu"∧X~D9λ∪0*Hr∩3Ht⊃2∀
(4tr)yβ⊂ ∀YPA!]
JRST CASE1D
IFN 0,[ ;TEIPORARILY(? ∩AI ∪∨-∃λ∩¬∪_p∪!+M⊂A Y∧~∀&DbJiα
a"¬$HIfB⊗≥!α⊗b¬∩⊗NNLz8 (!_4 LTλ∩e%*ZD@HαB(
4r∩D
⊃5H→β"B* tλ∀¬HC"B)
TVHλ%
⊂J!QB4ri~∪H⊂!Q@∧P%∀)j⊂$Q_`DDNc'i⊂⊃ df*T P"k⊂d*`j⊃P f&λ)"f`Rg$g#H#'i&TFE∧d∪)-⊂ K∀!∀FB∧a`dQP V*∀*j$εB∧P *Td%⊂( "k fβE∧h'T%⊂(⊗βEαE$Q_`]∧T*id⊂∀⊗!∧DNa`∂ND RE@#U∪% &↓!∨∪≥Q $A)<A→∪'PA∨≤AM)βπ⊗4∀∪∃%M(Aπ∨9λd4Uin⊗:"α&~9β4(0$*≥*
RRb↓
Nf≥"⊗ *$ T ≥)z2αj
9T dDλe≥ *$u~¬It¬∧
(→Dd,Dλ4|@4∩3λZH∪0(:Stc!'nnhλ:4TQ)J∪⊗.D∧∀∃4i¬λ∀∪j¬β"C!(ss3(YUλ∨∧λSsh$
ss1*I⊂3Qd ⊂4h
Ih⊃sd⊃"C"J85⊃NA~∃4r∧
⊂#!!2TTjD∀q5λf!"C!
q5⊃F*nB4
Zr∩Hλk∀ ∀hZ α"'→_;Y
L(_ ∞?;8[mD_x<lT_8h
≤H~=∧∞y<Y$
q5∀!QTq5λf.B2
*VH⊂EH
∀
!⊃.pP*90h∪ yβh⊂"∪kg⊂ T#f$iUεE∧d∀)-⊂! ∀!∀FB∧e*fT"P!⊗∀'h_eβEfgU"fP! ∀(∀FB)bj# ]∧d&∀-⊂ V⊂∀(∀FB∧iegU*⊂ V∪)FE∧H%))jλ)bj# )DD]\rz:4[3P0P≤|vq7[∨FE∧R&)-⊂⊂V∀ TCE∧ieSj*⊂ K)lFEαP%))U⊂)bj⊃→DD]T0s27[P37i≠pz∨FB∧fgk⊃dP!⊗∀ij#↔⊗∧D]w\⊂40yH)bj# l⊂8)≠x2y:≡←FE∧T*id%λ(⊗#bU_DD]H:42wλ3wP9[7{P)≠zz2P≥49:P∀bj#→CE JUMPN A,SETF3
MORE B,@(P)
HLRZ A,B ;Else check if iT is one o@_AiQJ↓gS[a1J@~∀%⊃→%4↓αXAα$~∀β∃M A(Y%εP~JH%mβ6{K7Mπ##πQ¬;∃β∂∞qβW9n#=β Jβ#π≠ h(%αU∩NQα≤*R→F⊂h*N⊗$1J
hMαVN!∧2bA2% $%n
↓∀≤~(4%∩)→d:b∞⎇↔&B∧-⊗≡∂,<G↔α$ 6}&T ⊗r¬JAPPM
Z4B¬¬H HK4∧ε␈∩ YG≡*
JBεF≡4αk
iwα¬ I∃≥ Q!∀De+$∧
d!Q LE*+"∧
Eλ∩Hh!~¬-≤ $¬αdZh∀d≤~!⊂K\=⎇Wπ/LTβf∂,wbαε≥`αα∩λ8∃∀≤J$βf∂,wbJ⊂Q!∀-D9∧∧
b
¬⊂hP~
U≤D$
αd-h→D
!⊃∪@8{{<∞↑→(∂∞l;∂H
≥HλJ
85⊃H¬λp4PhJH∂_.,oJ(πNX;∂E∀A"B)YuQ(λ%⊂#"A~∪tλ
¬⊂#"A~∪tλλk∀ ∃
A"B2JY4∪λ
J ∀uλfPlC!!3⊃⊂Dλ ⊗lεf
Wlf∧∃∃↔!⊃.p{lL(→P↔\⊂:42H⊃:0t[⊃⊂7h→y0z4[w⊂0w→εE∧e∃fh"P⊃⊗)j# !XFEαf"!⊂⊃⊗-Y≠L≠/YXλ∩a`i⊂b)⊗I
"⊂nDNP⊂3$[2⊂:4→P⊃17↑Q⊂7:[q2y⊂→7y⊂4]εE∧e∀h⊂*⊗⊂`i!b∀∀"∀DBD]b|→qzz2H:42Pλ:0tvλ⊂7x2\0z4w[εE)j⊃→!P]αj)''λ**⊗_WXY↔∧BD]a4]⊂→↔ H7s⊂1[r2P7≥vq2yλ4yP_H4s3⊂βEP*⊃- P" "∧DDNP⊂⊃4→pr⊃⊂≠x2y0]4ww⊂~yP)(∪ abεB∧P⊂&Sk"dP⊃⊗)(&⊂ab⊗i∀& a`CE∧h*Td%⊂( )(& P`T"∀CEe)∀j⊂)bU#~FE∀j#→!L≥∧h*Td%⊂( )bj(∪$ijεB∧e))U⊂)bj⊃~FEεB)bj# a≥∧aPdbP K(R#bU∧D]a[w:4w≥rP24\qry7~w3P3≠y⊂5w≠{w⊂7\2y0z~wwεEαP!`dS⊂ V(Pl)εEαP⊂%)∀j⊂)bU#→#DB]cbj ⊂!l)βEa`Rg⊂ V∀R`i)⊂la`f∪εE∧P∩))j⊂∀bj#→⊂DD]`T) laPf&εEαibj'H**⊗εB∧a`dS⊂ V(T&$ijβE∧P%∀)j⊂)Qj#→!BD]`&∩ij⊂∀⊂P!$jλ&$ebH!`i!Q)∀FEαfgk"H!V FB∧fgk⊃dP!⊗∀f`ai∪FE∧h∃id%⊂∀⊗#bj FE∧e∃fh'⊂⊂V)bj⊃_aFEαfgk"H V!FB∧fgk⊃dP!⊗∀`jj'S'`bεB∧h*iR%⊂(⊗⊃bj_FB∧e*fT"P V∀bj#→CEh*Td⊂(⊗⊂FE∧fSk"P K!FE∧Sgk"dH!⊗(f∀j#↔,βE∧h*Td%⊂( #bj&
DD]P⊂*j⊂&Pla"P∃bSk"H f)"Pb,P*∀$bb⊂∃'P jU'f'`Q∨FE∧T'h⊂( *εE∧R*fh"H V)bU#→FEαfgk"H V*∧B]dc⊂⊂jj'f∪`b a∪"V⊂&PlP *U⊂ P&Pai'P∪gεE∧T*id%λ(⊗ jU'f'`Q∧]P)SP"'`Q⊂$g∃$"P Uj'f'Pb a&⊃P#$f⊃FE∧fSk"P K!DD]H g"⊂∃),P Q`dg∃'P#$S ⊂&`Pi'P(∀'hεEαfgk"RP!⊗(S`aa'CE∧h*Td%⊂( #bj_CEe*Sh'⊂ K)bj# aFE∧Sgk"P⊂V!FEαfgk"RP!⊗'∩fεE∧Sgk"dH!V(iU#↔,εB∧h*iR%⊂(⊗∀*j()∪hεE∧R))j⊂∀bj#→CE)bj⊃_a]∧R&)-⊂⊂V ∀(
FE∧aPf"#⊂ E-selector ings)
JUMPE A,SETF3 ; - then merely MACROEXPAND-1* and go
HLRZ A,(A) ; around loop agaif
HRRZ B,@(P)
JSP T,%CONS
MOVEM A,(P)
JRST SETF1
SETF2A: HLRZ A,B
HLRZ B,(B)
PUSH P,A
PUSH P,B
JRST STF2A7
STF2A5: PUSHJ P,STOREE
STF2A7: SETZM LISAR
PUSHJ P,EVNH0 ;EVALUATE ARRAY BEFERENCE WITHOUT HGOKING IT
SKIPN A,LISAR ;ALWAYS CHEAK FOR THIS GROSS LOSS
JRST STF2A5
SKIPN V.RSET
JRST STF2A9
JSP T,ARYSIZ↓ ;GET SIZE OF ARRAY IN WORDS IN TT
TLNN R,200000 ;=> NEGATIVA INDEP⊂~(∩Aπβ%∞A)(0Q$R∩$s)⊃ I
O&AA%∨¬β →2Aα↓
≥π∀[!∨'PA
∨$↓'0AβI%β3&↓⊃β%
4∀∩@A)%'(AM) eαT~∃')_eαrt%!+'⊂↓
1 YH~∀β aπ⊂Aα0Q B~(∪!+'!∀A Y∃-β_∩$w -β1+β)
↓)⊃
A9 .A-¬→+
~(∪!∨ ↓ Y→∪Mβ$~∀%!∨ A→1 Y$4∀∪∃'@A(X]M)∨%
4∀∪!∨A∩A XD~∀∪'∃)5~A1∪'β$4∃π' Q jt∪)%'(AM ) j4∀~∃'∃) e∞h∪!+' A YπM ) j$∩vE∂∃(DA∨H@Eπ1HD~∀∪!→%4A∧Y∧~∀%⊃%%4↓αXQα$∩∩v@DQ' Q @Q∂∃(@yCINb|@qCeNdxR@ym¬X|R~(∪⊃%%hA∧XQ∧R~∀∪A+'⊂A@Y∧~∀%!+'⊃(A Y Yβ→πβH∩∩w YCX@y¬eNb|4∀∪ 1
⊂AαX! R4PJBVNDQαA2-2ε2∞
⊂$%n/3π1↓f K≥Iph(&B-~!αAdλ4(εE∩Jiα
b↓5ME↓$4(MαVN"RαA2⊗4
2∞ε⊂H%n↔6 1↓s6 1x∀PJ"2JRαQ2↓k→"A∧hP&"2∃QαQ1E!$4(L~ε&9¬!2E∩<*P4(Jα*JN αNR→∀9H4(Lj>Z∃∧→2∧4PJB>A¬↓2λ4PJB>A¬↓2∧4PJBVNDQαA2∃α2ε∞@H%nJ,j⊗6
-⊃βK↔'+K9β∞#∪Iβ> EβC/≠#↔⊃ε ?[(h(&6⎇2∃α¬d_4(&∧zB)αα`4*N$1J≥IPJ6.Z*α 2∧HI`~ε≡@¬≤-Hf$8h!~∧⎇α
¬D_h!~∧⎇α
¬Dλh!→%∃≥D
¬-%λ∧Sj↓ C"HZβ f!Pi→⊂⊂∩&)-⊂⊂V⊂ DBD]yp]2P0@ couple of instructons! by coming here
JRST EVAL
SETF3: POP P,A ;Can't hack it, so give up andlet @QQJ
∀%' )4↓∧X∩∩$p
α jA%↓ukqα≠∨⊂α[π∪.(4(_8∀dddε"e ~:D5@⊃↔2α\→jD-∀h→Bm≤ZHbmB [πε∞lLW∩ε←∞ε∞vD
↔"pQ!∀U∃:@∧-∀→A⊂KZ ≥f"πM VrεMtεO"aQ hWD↓∪L,hD∧|2λH∀lt_)D*∧:ZBl]X@∧|2
8U$2λj5,∃!Q `H!Q#K[4
7&∞βY_.,λ≤r-↑≠→(
4r <<y(¬ [|@∞∨98[mNj(∩.P0yP→5v6']y]εEλ⊂≥P⊂λ⊂⊂∀"⊃c*g⊂∀*id⊃ l )λ∀"∀PβE⊂⊂≥BP⊂⊂⊂λ⊂∀"'H∀∀$⊂∪⊂∀!b⊃)⊂,)) CYM) (VAL))
; ((NULL X) @-¬_R~∀@v@∩$Q' )DA'3~Qπβ HA0BAYβ_@Q∃)β_@!πβ$A`RRR~(@@v@$∩Q' PA'3~Qπ∨≥LA-β_Q'3≠∃)β_AM3~RR$RR
∀lrvA'β#π;∪∂∪⊃βONkC#∃¬α>Aβ≡ O¬↓F3?Iβ∨K7 ?g→%β'~βπMβ4{33??→`4 α↓m"∩,2V9α∧zAα~-BBI↓EA$4 α↓d%"¬∩>≥HhQ↓↓mI↓↓↓BI4)α↓e↓↓α↓↓↓↓αB∞>~"↓!":,b1↓"≤"IαaJI↓"∞
⊃↓"NLj⊗Zεb↓"∞ε∩αa%%JH4)↓βX$%↓B:Q↓"≤*Q↓"≤
∩Iα@I↓"∞
⊃↓"NLj⊗Zεb↓"∞ε∩αa%%JI%$4R↓↓l%α↓↓"N-!↓"∞
⊃αa%αB∞∩IαBNf6-2ε1↓D~εIα@I%%%JH4)m[Y↓α?&C↔K←O≠∃1β>)βSKJβOW ∨#'SW&K;≥↓\J:R⊗∀rε16¬*N!6B↓#?IαZ&:R-∩:ε1mα>A6@I4)[Ye↓↓ε3?Iβ&C∃↓
¬*N! αC?I↓∃α>A Ja↓βπv!β#↔"βS#∃αCπWS|c?π∪∞∪3∃%εkπ∂Kxh)mmZ↓↓β↔Gβπ;∪/⊃β#πv#3∃βM!84(hP4)∩¬*N"⊗∪QαB>ααA2∧hP%⊗↑$ αR:Lb⊗H4R"BVNCP&*NααRQ25::ε∞Xh(%α4 I12
"BVN@h(&B-~!αAdλ$%n≤
Z∃α$B∃αε∀:V6⊗u!αB>LrR⊗HhP&BV≤B)αAd~ε∩HhP&*Vmα∃α¬b"BVND*H$%]~B⊗∞L
16∞
~∃α∞D*ε-α4zIα:Laαε:"αP4(L~ε&9∧ 2RJ-" 4(Jα*JN"↓∩BV≤B⊗H4PJ*NA¬!2NB
"64$KZ∞"⊗≤Yα~>∩αNRεt"εJ⊃∧~εN∀hP%α*∃~Q↓∩¬*N!DhP&"2∃Qα¬2αBA$$KZ≡⊗Q¬""¬↓∃2ε"V*⊃αR=∧∩∃αB-~"⊗⊂hP&BV≤B)αAd*Rε0HI`~∧→hB∧-h→E,
HT∧M Q!∀-D9∧∧
b
¬⊂HK8∧p*h(⊃∩λT∀Q4jY∃ λλ→Qλ⊃hZλ⊃∩λT⊂4Qd
⊃r3JH4C"A→Ttλ
E 0p(J@".hx5λ∃ λ(⊂q(9sQλ∧λ4Qu)X3UλAQ@4∃*9λ∀ λ⊃".th~Q(∀ y3U⊃*$∃∪h
;30SiA B4
Zr∩H
¬⊃5Tk→"".hx5λ∀k→0Ss∧zh∃P)J1#"A∀⊂QPiA"".i_H∀ri~λ⊂Q*J4S@⊂∃ibP'⊃kP*iQi⊂# S*bFEαfgk"H!⊗⊗HJ(⊂ ;GET THE THINGTO BE PUCHED
JSP T,%PCOLS ;PUSHMJ DHE "STACK"
POP P,AR1 ;GET BACK POIH
) HA)∞AM3∪¬∨0~∀&U~AαQbrN⊗PHIfNR⎇∩∃α
~-αRD)α:⊗8↓∃≥H_4Z∩λ tL@U⊃4AQB4∪j (⊂ ε⊃"B4 z⊂H∀¬A"@↓A C"DJ∪t⊃*'H∀∪j∧∀ ⊂!Q@)5jH(∃∪I→⊃4C!$∀∪tπ!2Tt∧
∃ ⊃JyP0raQ@(⊃H⊗,K
∀∀∪t↓QB4∃*9λ∀ λ⊃"B4
Zr∩H
¬⊂q∀AQ@2U)Z⊃(⊂%D∀∪tεA"B4
Zr∩H
¬⊂p4AQ@2U)Z⊃(⊂%D∀∪tλZC"B(823Hλ∃∃∀U*Iβ"B$ TTu∧∧∀∪tλZB#"A→Ttλ
E∀t⊂*Is#"A∀∩TTjD ∀∪jε#"I
t
∞A→∪∀VDλ+⊂
¬"".hx5λ∃ λ(λTjH0rhD
∪r3JH4C"A→U34λT⊂+
t⊃4AQB0p)→H⊂+
JU5∩↓Q@(∩J*uλ
t⊃4A⊃"B2J:λ∃
:⊂5∪iQ"B( *Tuλ∧J∪t !QB4∃*9∩H∀¬H5P3↓⊃.p3HD⊃q5∧
∩⊃(∧*u⊂0i4C"B*
4rλ
¬
⊂*!⊃.pp*h(∃∩λT 4u∧λssTd qH∃ λ(λTjH0rhD sH∀↓Q@2∀J+H⊂+λ¬,*∀¬⊃".qhZλ∃∩λT∀∪⊂(8(∃∪d
∪tλ →U∪c!!2U3*λ(⊂+∧J∪t A⊃.sSjD∀t⊃(91R1(Eλ∩U*:λ∀Q*J4SH
I⊃(∃ zλ∪qD∧Tu⊂(9hC"A→∪∀VDλ+
⊂%⊃"B2 JVH⊂*&+
∀¬⊃".ph~H∪qD
u⊂0i4∩4h
h3∃1$λQ23Ht∀∪t
λ1β"A→Ttλ
E Tq*F"".j85λ∃ λ(∀v)XSsλ →U∪h
y∩0r∧ 5λ∩*4∀∪t
3Qc!$∀∪tε'B2∀J+H⊂4F∃
∀
!⊃.sSjt⊂q∀D
∩⊃(∧*u⊂0i4H⊂3HD∀Q+*85λ∩)j∪h∀jIk4∃
!"B2 JVH⊂%E,0
¬#"B)*tλ∃¬ETq5ε⊃"B2 JVH⊂%E∀
"!↔tQ5
ZSH∃ λ(⊂p*$∪qH
I⊃(∪HZhλTjH0rhAQB4∪j (∀ ε!"B4 z∩H∀¬A"C"AQI∀∪jε.B4i94⊂(λ5⊗t2* v↔"!↔hT∃*9λH⊂)hλλT zλH⊂h→Uλ⊂HT∩⊂3HI⊃1β!$∀∃4iε.B(∧ 3uQ)∀⊂k∀)~∃6α!↔h∀{d
;][m<(≥~ T∪∩4j¬8{y \λ
r)j⊃4SH→ 9[mu6β"A~∪tλ
¬⊂""!↔h≥z
≤zλ→/∞_;Y∞4~=λ m|H≥.1"B4hZ⊗H⊂EA"".dλO*
$
98;N4λQ[n$∃X;∞\(C"A_p3∪λd K
λ5#"B)*TuλλZP3α!↔x;Y∧λ5P3∧∞~→(∞,<⎇;∞A"C"JIR3⊃*'H∀r+λR5λ Hp3U∧∧T∃4i∧H∪tD∧T∪t∧$∃∪h
D⊂3Q∧ R3λ+A"C"@↓A"C"J:0U∃ A4u∪j(+λ⊂J(02k∧
r1sJ↓"C"J:∪tQ'!2Tt∧
∃ ⊃JyP0raQB(λ∧λP,K¬J4u∪j(#"B) ∀VHλ%
⊂*!QB4∃*9λ∀ λ!"B2
*VH⊂%E⊂*#!!2∪∀K$⊂+
λ∃#"B*
4r∩D
⊃5H→α".hZP3∃(~⊃(∀hXqsQ∧λ4Qu)X3Uλλi4Tu∧⊃"B4
Zrλ∀¬H#"TjItQ-g!2∀TK$⊂+ &∃∀
#!!4q5 )(∪∩*84C"A~∃4r $∀ ⊃*iR α!↔q5P)J05⊃$λ4TP+∀∀Q1HZQ3PhT∃r5 u5λ srr)hh∩5↓QB4ri~∪H⊂%I∩4p*!".p)Jp64dλr⊃0i4⊃StD
∩∩4dλtStj4∪∪tj1"B( *Tuλ
:∪tQ&Q"B4i94∪H
ETTq*A"B( *Tuλ
:∪tQ'⊃"B2J:λ∃ λ~V4r+!".qhZλ∀r+((∪qDλ4TP+∀∩3H
ytQ∀d 3H∃
A"B5 ISH∀EFL εεα".gWH∪Q(x5∩5HT⊂3Qλ[β"B$λp21d
∃
%"".jI⊃4Q$zh∀∀IxP0S ∀⊂(⊃HYβ!bVT'ij⊃'i⊂)V⊂ i)⊂liP$⊃i"FEαP⊂%)∀j⊂)j∪i"ZFB)j'i⊃\]∧h∪h⊂(⊗⊂FE∧iUa⊂(⊗∀≠X∃XCE∧e)T⊂*⊗↔∀j'i"CE∧ibU-&P&∩i`iεB∧h'h∩⊂(⊗εBεEεE⊂)"`eN∧e)hλ**⊗#∃e aeBD]c)Ua)⊂∀ P∪⊂→
FE∧Pλ⊂# XL⊗⊗(a∀"`eFB∧d&)⊗⊂!⊗∀⊂TDD]P%h"∪ fbFB∧d))⊗⊂ V∀⊂TFE∧R*fh"H V∩!∀%X∧DNe'P)Qacg"λ i#P∂←⊂ f∃`liP⊂)"`eCEd&∀-⊂ V
TDDNj'Va∀"`eVSi⊗g'U⊂)kdU!dεEαh*idλ(⊗!εB∧h*iR%⊂(⊗⊃hεAL ;THIS IS A CROAK!!!
↓POP P,B
∪∃I'(@I %ββ⊗$∩wα@tA¬% ¬↔ HAλ@rA¬I β↔∪⊂~∀4Ph"N_yeβP→*5α¬JAD5<h_4XH↔8e≥ * β⊂H!∀αα∧h∩"be~9∀<u↓Q M¬X9α¬αEλ∩Hh!→∧e∃$λ∩bD∃⊃PPM
Z4B¬¬H⊂hU9_teβ∧εB*
4r∩D
∀∪Hx5β"A→∪∀VDλ+
⊂%⊃"B3)zTh∃¬E⊂*#!!2∀TK⊂ V∀⊂TBE∧R*fh'λ V)dQe("FB∧fgk∪$P F
α
CAIE T,@SPTB+6(A)
α AOBL A,&-⊃
∪∃U≠!∂
↓αQ'∪≥→!
~(∪⊃ →hAαY'A)∧Vl!αR
∀%'#∧A@Y$n`,b~∀∪∃1π⊂A∧XQ R4∀∪⊃→I4AαX!αR
∀%!+'⊃(A I Yβ_~∀%!+'⊃(A I≥U≠¬ ¬@~∀&U*6B∃∧ 2B>β
(4(Mα>AααbP4λLBJJ%¬!2RJ,(4(&D~QαPhP&*J≥!α~εe~∀4(hRNBR⊂π hT~*α¬
EK4bdUID*DuHt*dkQPPL*YUα
∀
E"bλ~4≤L∀ E
b⊃Q%$-)Y∀`H
SUBTTL PROG2, PROGN, EQ, RPLACA, RPLACD
PROG1: SKIPA R,XC-1
PROG2: MOVNI R,2
CAMLE T,R
JRST PRG12Z
HRLI T,-1(T)
ADD T,P
SUBM T,R
MOVE A,(R)
MOVEM T,P
POPJ P,
PRG12Z: MOVEI D,QPROG2
CAIE R,2
MOVEI D,QPROG1
JRST WNALOSE
PROGN: AOJG T,FALSE
POP P,A
PROGN1: JUMPE T,CPOPJ
HRLI T,-1(T)
ADD P,T
POPJ P,
EQ: CAMN A,B ;SUBR 2 - POINTER IDENTITY PREDICATE
JRST TRUE
JRST FALSE
RPLACA0∀∪M↔∨)(↓αY→&4∀∩A∃I'(A%A→πα`4∀∪)→9
A)(1!+$WYε~∀∩↓∃%'(↓%! π∧b~∀∪!%→~AλXQαR4∀∪!∨A∀A X4∀∩∃%A→βπλh∩∩∩∩m'+¬$d@ZA
→∨¬¬∃$Aπ HA∨ A→∪%'(↓β%∞A]∪!AM π∂≥⊂~∀∪'-∨)(A∧Y→&~(∩A∃%M(A%!1πλd~(∪) ≥∀A)(YA+$~∀$A∃%'PA%!→
λb~∃I!→πλLt∪⊃%I~A∧X!αR~∀%!∨!∀↓ X~∀4⊃%!→
λdd∪)+≠!
↓αY%!1πλ`∩$rQ%!1βπλA9∪_A
=≡RA∪LAβ→/¬3&Aα↓→∨'&4∀∪'↔%!αAλ1)π $4∀∩Aπ¬∪≤A(1#→∪'P∩∩w∪_Aπ $zA≥∪0A∨$A1∪'(X↓)⊃ ≤↓↓∨≠¬=+(~∀$@A∃%M(A%!1πλ`∩$s'β≥
Aβ%≤A∪&A9∨(A→%'(A∨HA≥∪_4∀∪πβ%_A(YE'3≠¬=_~∀∩↓)→≥
↓)(Y'd~∀α@↓∃%'(↓%! π⊂f∩∩w% A≥∨PAπ $zA'∪5¬∨_X↓)⊃ ≤↓β≥3)!∪≥∞A≥∨ &~(∪∃%'PA%!→
λ`~∀4∀∪!∂Q_∞Aα-212n-2ε11∧
BB2JaαNR,2→α>∧*96∞|"⊗⊃α∃Iα∞>mα2JthP0$!Q hRI→e≥∃Dλt ∀_!⊂K\x~$∧ xT∧ \IHT
∪tHλ→Qλ⊂)I⊂πa`U$gg SPUFF
¬
$INSBT READER ;READAJD REH β)∃λA
+9β)β∨9&~∀~(I∪≥πI(Aβ%Iβ2∩∩mβ%%βdA!βπ-β∂
~(~∀I∪9'%(A→β' ∨∧∩∩w
¬'→∨β⊂@~∧~(I∪≥'I(A#∪<∩∩w≥∃(
α⊗,bR&Bd)α~&d)α%>zα~V:≥"&.:_h(4(04*≥*
RR`J&:R-∩JVB"α"ε:$b⊗JLhP4(&∧:
>Q∧J:P4Ph*&~rα&RMeX4(4Uα&">d!h%:≥α&∞2∩a2I]α$%n<zJ⊃α$y↓ :≥*N⊗Q∩αR=α%*J9α|2→α&u"⊗JJ-αQαNM~R⊗4hRB&:∀ah%:≥α&∞2∩a2b
k $%]:>J⊃¬"=↓ u~VN⊗"⊃αR=¬"VJ9∧z9α&u"⊗JJ-αQαNM~R⊗4hP4)m[Yα:⊗:jNRfd)α&:$*JJV¬!αRJ rN~⊗⊂αZ⊗∞$zH4(hQ:N⊗*α&6ε≤X4)m[YαNR r∩εJ"αZε2,*MαRzαBVQ∧J9↓:l
N-α r⊃↓:m~-Iα-~⊗Iα4
J&ε∀b⊗M8hQmmm∧J:R⊗∃∩VBR~α:>Jl
22e∧*:ε
d*⊃αε∀)h4)[Yl&B
∩&Re∧*JJ>⊂h)mmXJ↑J&$)α&:$yαJ⊗ !6>:eIα6⊗lzJd4SYml&l*6>JJαBJ>$*∞R&|qαZ&|bεR&|p4)m[X&&2d*≡ε1∧zB⊗J
"&>8hQmmlMα∩1α⎇2⊗J~dz\4)[Yl&%|yα∞" r:⊗1∧*JJ>⊂h)mmXJJV9¬"&&∃∧~2>∞Xh)mmXJJ⊗εbαR&6*α∞2>≤X4)m[Yαε2≤y1α~⎇⊃αR"*αVN⊗d*NMα≥:&R∞CP4)m[X&∞2Jα∩⊗ZL~∃α&u"⊗JJ-αP4)[Yl&NM~R⊗5∧:>&::α∩>↑rzJ⊗ZM2⊗⊂4SYml&≥JNR⊗jα
⊗&t9α∩⊗∃*≡≡⊗ h)mmXJ∞>:%∩>1α|1αRRJα*VN"α≡&Z,qα
ε≤YαR=∧b&N@hQmmmαBNNR
"VMαl
I%αl
eαεe~=α⊗t
2∃¬""¬αl
Iα&u"⊗JJ-αP4)u~⊗∃α≥~6εHhP4*N
)αNR$jN-u-α&Bε∩Y⊗B&=∩=-⊗∧J6BYZ*B&&dy-⊗BMα∩1--α&&>~Y⊗B&∃*9-⊗∧JJ2PhRN¬⊃¬~R∩6≤Yu⊗BLjε%--α&Bε∩Y⊗B&=∩=-⊗∧J6BYZ*B&&dy-⊗BMα∩1--α&&>~Y⊗B&∃*9-⊗∧JJ2PhR&~9¬*N⊗2-~M1α≥"∩6N[jNR∩m~--⊗∧J∩↑9Z*B&∩∀9-⊗BL
Rd4T"
≡6≤YvNR$jN-5b*B&B
⊃-⊗BLjBY--α&&2zY⊗B&
"ex4Ph)mmZαε21∧I>-α≤Bε::,bMαε∀)α⊗: ∩2⊗⊃bαε:⊃∧
21αTz α∞D
::⊗e→α~>∩αVN⊗d*NMα≥:&R∞Bp4(∀U~R∩6≠⊃uuE;9]]\hR&~9∧R>
FLy1αN$"6MIkjNR∩m→I-q≠9]11ph*∩
<jMIum~R∩6≠⊂4(4Ph*∩⊗4J:¬αLrR≡Jαα"ε:$b⊗I.∧JJF
k↓2&~∧JIuAd"→Ev≥"∩6NZY⊗B&l
I5q-α&B∩bY⊗B&∧
I-⊗∧J↑J=Z*B&6¬1-⊗BLJ2=yd"→Iv≥"∩6M⊂h(&BM∩F 4PJ&~BM⊂4(&$1D4(L"→H4PJ"ε:$b⊗H4U"⊗J6Lp4(∀Ph*&:%2⊗
hL"⎇Y-~a2&:%α∩0$KZB∩1∧2>Iα¬*N"&t9α&:$*JJV¬!αNR,2_4(HH$%n ~Mα⊃bαI1α2αεJ∃¬~εZ⊗"αε2>t9α↑&$Aα>RD*Iα∞∃*⊂4(hP4*N
$&&u"≡JA∧j⊗6⊗∃⊃2B&∃
u⊗∧J6ε%X*B&B
⊃-⊗BM:J=--α&6B2Y⊗B&Lb=2∩3 vNR$jN---α&6ε∩i⊗B&∧"0%nl*6>JJαε:⊃∧zB∞>$)α⊗J∀zJL4U~¬∀$LJ:R≡∃↓α6⊗l*JI2∧JJF
j*B&B
⊃-⊗BM:J=--α&6B2Y⊗B&Lb=2∩3 vNR$jN---α&6ε∩i⊗B&∧"0%nl*6>JJαε:⊃∧zB∞>$)α⊗J∀zJL4Ph*N¬ H&&:$:JAαl
&&:"bB&J →u⊗BMα∩0$KZNε&bα6ε&bα&*R-∩JVB h($&LrR≡JααB∩∩⎇12B&∃
u⊗∧JB∩0HIfB∩bα>J⊗∀22>\hP$&&u"≡JA∧J>∞⊗∃⊃2B&∃
u⊗∧J&> HIn%>zα∞"εtr⊗1α-∩J>HhR&~9¬*N⊗2-~M0&LrR≡Jαα∞"&LrQ2BM∩F
u-α&∞I⊃⊂K\9I∩∧LjHU∃∃Z
@hT_ib¬-8YD-≥5A∀L@U⊃tJ∧∃∃∀I→U ∀ ~T0o$Z∩05 ⊃".u
K(∀Q*J4SQ(D∃∪h )pC"I_SH∃*83⊃4j5α23JHtTλ
;4r3JE∀∩4J_o)4 _∃sJdZ∩1⊂Hq.tv*4⊃∪uid∪tHλλ23Qdλ⊃0U(xq1β!)1SH )pT2)@V∧dg∃#i(⊂∩'a$g∃⊗$c(∩i≡eYM[V⊗.BD]dg⊃"i$gT⊂()'Pbb*i⊃iFE∧Bdg*#T(⊂!d∪$g*⊗∩c($i∂X[[[M[DD]RWcP!R g'"S⊂$g*⊃i)*h∃)FE*∃,b#_O↑]↔-3 .SEE UINT0
TTYDF2==:.-2¬
IFN USELESS, INTGRP MARINT,PIRQC=%PIMAR 9IAR @REAK
↓ INTGRP RUNCLOCK,PIRQC=%PIRUN↓ ;RUNTIME ALARMCLOCC
INTGRP REALCLOCC,PIRQC=%PIRLT ;REAL TIIE ALARMCLOCK
LINTVEC==:.
INTVEC ;LENCTHOF INTERRUPT VECPOR
;;9 FOTE THE EFFECP OF HAVINC THE ALARMCLOCKS LAST:
;;; IKC AND CHANNEL INTERRUPT HAPPEN FIRST, BUT WHEN
;;; THA @IOJ HAPPENS INSIDA EINT0 THA ALARMCLOCC GETS
;;; ITS TURN IMMEDIATELY. FURTHERMORE, THE REAL TIIE
;;; CLOCK GETS SLAGHTLY HIGHER PRECEDENCE.~∃t∩∩g 9λA∨ ↓∪
≤A%)&~∀_∩(hR&~9∧!IA2Xh)mmZαR>B~iIAαLrR⊗J∃*BQαD
:∩2-⊂4)M[Yα&:$*JJV¬"Mα~|jJε2eIα⊗: ∩2⊗⊃∧
J∃hhQmmlMα∩1α⎇2⊗J~dz\4)[Yd&&db⊗≡εbα&*N%∩V∞RLz8 ('73HL→ID,<→D∧l,Yz%J¬(X∀ hαNng⊃23∪λXp3λ X33tK∀∃tR*H!"Ng↔b3SiH4∩4jH3Uλ
λ1q(
(1Q4HYβ!bFB≥]]DU i$gUiP!d⊂i aj⊃i)P"S a&"Q⊂#'iλ$g""T)*h*∀]αE≥N]DDo⊂V⊂'! ⊂/"ελ-"V⊂↔#⊗⊂/⊃V⊂'+ ⊂/+Vλ/,⊗⊂↔-εEεB∧E≥]Nβ CHANNEL ASSIGNMENTS:
;9; 1) PDL OR¬
;8εv∩d$A∪→→∃∂β_A%→')%Uπ)∪∨8XA∪→0A≠ ~↓$@LA\XA∨)! $Aπe→εA∪9) %%U!)&~(rvv∩LRAβ'e≥π⊃%=→∨+&↓∪∃) I%+!)L~∀
∃⊃∪' π,zz`∩$∩w∂ 9 %β)∀A∪≠!=%)β≥PA∪≥ ∃%%+!Q&A βM⊗~∃∪I A
∨<XY6]%β!∨,0Y∪π∪1∩P⊃~L~&J⊃br&∞ε=⊃1:&≤rbBthQ↓↓↓∧"&N⊗α93klI~4m≤53C
{F6RrliyssPQ*D-∀Y→`hPβ"TjH∪4rgW1∩4iZrb"!↔qq3HZP5⊃$
u⊂3HH4Q →U⊃4J*4∃ X4rc! 4Tλλisk ∃R0qλ_5#"D∧λλ∀jH∪4rgW4q⊃ Zrjoε≠o m%e1SsggC"UλZS23AQTu⊃ Zro/*:⊃∪4i5o
mfε ¬F efVoB.h→∀sh →β!f*Q"P f∪⊂*ibT⊂ iiRcg a∪ P!d⊂g'"f∀FE"!⊃fieNOij"&TeDDDNc'i⊂∪'kV⊂∪`ieiH i"P⊃hjdk⊂f"g*βEαE≥Pd g'⊃f⊂" P&"P∀⊂iidcS)P P∀)$gi∩j,P&⊃hεEL AND HAJDLER ADR TO EACH CPEAT 6, 3,,INTASS+<.RPCNT*3> 9FIRST 6 ASSIGNABLE IJTERRUPTS
0 ? 0 ? 0 ;ARITHMETIC OVERFLOWS
1,,$PDLOV ;PLDOV
0 ? 0 ;E-O-F AND DATA-ERROR
0 ? 0 ? 0 ;BESERVED TO DEC
2,,INTILO ;ILLEGAL INSTRUCTION
2,,INTIRD ;ILLEGAL MEMORY READ
α 2,,INTIWR ;ILLEGAL MEMORY WRITE
0 ? 0 ? 0 ? 0 ;RESERVAD, AND ?
2,,INTNXP ;NON-EXISTANT PAGE
0 9 CHANNEL 23. LOSES!
REPEAT CINTSZ-6, 3,,INTASS+<6+.RPCNT>*3 ;REMAINING ASSIGNABLE INTERRUPTS
IFN .-CHNTAB-36., WARN [WRONG NUMBER ENTRIES IN CHNTAB?]
;LEVEL TABLE - WHERE TO STORE PC FOR INTERRUPT AT EACH PI LEVEL
LEVTAB: 0,,INTPC1
0,,INTPC2
0,,INTPC3
;;9 TOPS-20 IJTERRUPT HANDLING ROUTINES
;;; CALLED AT STARTUP TO REINITIALIZE THA INTERRUPT SYSTEM
ENBINT: MOVEI 1,.FHSLF ;MANIPULATE OURSELVES
MOVE 2,[LEVTAB,,CHNTAB] ;INTERRUPT PC STORAGE TAB,,CHANNEL LOC TAB
SIR ;SPECIFY THE TABLES
SETZ T, ;LOOP OVER AND ASSIGN DTY INTERRUPT CHANNELS
ENBIN2: SKIPG 1,CINTAB(T) ;THIS ENTRY USED FOR TTY INTERRUPT?
JRST ENBIN1 ;NOPE, GO ON
MOVCS 1 9CHARACTER GOES IN LEFT HALF
HRRI 1,(T) ;CHANNEL INRIGHT HALF
↓CAIL T,6 ;RELGCTAION NACESSARY?
↓ ADD@∩@DXdh\4l∩∩we &HA5β↔
AI β_A
⊃β≥≥∃_A≥+5¬ $~(∪β)∩$∩∩gβM'∪∂≤ααR⊗JlJ2ε1∧J:R⊗∃∩VBQ∧~"ε:t*04
,r
&9 P&∞εL:∃αQd~&*R≥Q5D%\">:∃xh(%α z*¬α b⊗*
LqH4(Lj>J⊗J↓E1:4BN2_HIn⊗: ∩2∃α
αBJ>¬∩&εR*α∞"εtr⊗2LhP&6>4)↓I2]~R∩6≤Zt$%\*:ε
d)αNR r∩εJ"α&*R-∩JVB%_4(εlzZ⊗5β⊃2&6
~,$%]""&M∧JMα∞-∩J⊗:"α&*R-∩JVB"α6εNXh(&6⎇2⊗5↓⊂b>&6
~,$%]""&M∧JMαεe~=αRD)α>2 j6εNXh(&εL_4(&lzR⊗%β 1:~E~2_$KZ⊗*ε∀b∃α>-⊃α&:$*JJV¬!αNf≥"⊗4∀UB∞BB∀x4(ε,JH4(M~⊗Rj∩↓E!HHIn∩>p:Qα2,
Z∃α∀
:∩>lr⊗NM∧J9αB∀zR⊗∞αHT"∧_:0hTiz¬∀xQ!∃∧⎇ $¬α`Q!PS](XTt )HU~∧→jD-∃*Z¬%~λ_e$-$
DD-α(∩λ~Q(⊂HX3H⊃ ~p0SλXλ⊂V$λ⊂3∩)jλ∪tDλ∩4r)jβ"THX23Uπ!4∃4i∧∀ !QB4∃*9λ∀ ε!"V⊂jJ∀Sc!!03thT⊂∧g*⊂f&∧DNb$i`P&"b⊂⊂f&⊂$S*)WFB∧P)eRh P→ 'df`TeDD]S'V⊂*TbP'f⊃⊂ g*⊃i)*h∃⊂&`iRFE∧Pλ)edh⊂P→⊗$S`ieDB]bf)QP*ibH!ji)⊃g*⊂&PieFEαP⊂⊂&Si"fP ⊗$f`TeD]j∩$iP$TP#'kH*$"P⊂hi)"S*⊂&`TeFE∧Sgk"dH_V↔#∩)b#∧B]i"bS a&"H$g""T)*h*∀P#'iλ'ja)Qf#εEα`daFB∧h'hλ(⊗→εB∧h'hλ(⊗_FB''h)∪FE∧h∪h!⊂( εAεE∞h∧HIS ROUTIH
A⊃∪'β¬1 &Aβ1_A∪≥Q %%+A)&A
I∨⊂∃α|~∞FJLr≤4)]""¬α4bε≥αLrRε2bα&Mα≤*QαN
J&*≥¬"5αR,b1αRD)αJ∃l*2ε
d)αJ>-"& 4T
Dz¬(Z5$⎇(QPSZ →e$-**U¬%4λe∀|T ∀l
94¬∀
IλU∩¬Iλ∀r∧y→T
≤1Q%<
)`¬M∧ →dZ∧_)u-"
Z4Ltt∧t$M$p∧4⎇$λD d→jEhh(H∀dLjG M¬Z9α¬αF⊃PPM
Z4B¬¬F hUλ:E¬∀qQ M∧~:D⎇Q!∃∧⎇∧
αc⊂Q!∃∧⎇∧
αcλQ)d⎇¬)qPPM z∧R¬¬APPh'8DM≤_)D*∧→IB∧∃ZD∧Lm z%$ jD∧LuHZ%∃-
J0hS9→T
≤4 ∃~∧Yzd,"
Ir∧|→X∃≤ZDλ∀t" →T
≤4 ∃~¬8ZE-α
Ir∧tZp∧
-*(Tu" X∃≤Z
h∀e,QQ$$M9→e#P~
U≤B
¬CλH↔:t*¬y→Db∧hXT"¬Jyr¬<z)4Lttλ∀≥_Q!∃¬-9∧¬αc!Q%D≥J
$xh!→T⎇∀Tε"dLX~4XH↔8t-"λ:U∃∀YjB∧LjHU∃∃Z
B∧l~90hP→Yu$,Tε"d|→X∃≤X⊃↔5-∧H~D*∧yHB∧l~90hP_→d"β%K4$M9Z4]h⊃↔4|tK∀∧ dIzr∧LZ u∃$→jB∧LjHU∃∃Z
E_h!→T⎇4YTβ∩d→X∃≤X⊃↔4t-t T
≤1Q LlzhTJβ∃Ed4E9H`hP_→∀_H⊃↔4l 8T¬≥-(T¬$DT ∀m∧z*D uD ∀u$Z*%-¬J4∧
∀T tph!~4-$8∀β∩`Q!∀$L1⊃⊂K\*ZB∧|iK∩¬$λT∧Lm z%$ jD∧LuHZ%∃-
J0hP~ uᬬF hP~ uᬬF⊂hTiz¬∀xQ!∃∧⎇ $¬α`Q!PS[74∧$M9Y∃≥~λ→b∧LjHU∃∃Z
@hTJ9TLuG!PUD:J¬∀xQ!∀ ⎇4λE≤m8~`HK: tLuD
Dz∧h[¬"∧j(T*∧Ix4
$→ybαD∀
4l ID¬≥$_92Hh!→T⎇4YTβ
dλJ4m≤~a⊂K]8~d*∧_4βλh!→T⎇4Y∀β
bhi¬≤da⊃∪]%Z)b∧|hd¬≥M:HTj∧→jE~¬y ∀d* ZTt<→hr∧LjJ∧$`Q!∀$M!Q LlzhRβ
I→e%∧IA⊂K\izr¬,hIr∧LjJ∧$`Q!∃∧⎇∧ε∩d0Q!∃∧⎇∧ε∩e⊂Q!∃∧⎇∧ε∩d ⊃Q M∧z∧β
d¬V∩C
⊃⊃∪]∀Z:D⎇∀T
$-%X)b¬∧1Q M≥X$β
e&vα[λ⊃↔5$E)zr∧
x≠∩¬∀XJU∀r
λ2¬∧y→e$-!Q M∧z∧β
d→X∃≤X⊃↔5∀-:Iu∀* yD"∧→X∃≤XQ!∃≥,$ε∩e∪v¬3⊂h!→T⎇4YTβ
d→jE∧$AQ LlzhTJβ∃Ed4E9H`hP_Y∃⊂H⊃↔4t⎇tλ∀ddzt∧LUHZ%∃-
J0hP→Yu4,∀ε∩bti
4d0Q!∀ ⎇4λE≤m8~`HK88∃4*λ_2β∩ yb¬$z∧∧|2
:D ≤1Q LlzhTjβ%H∧%≤X8∃0h!→T⎇4Tε"dLX~4XH↔:D,dD
D⎇¬5V#α∧_)u-" yD"∧→X∃≤XQ!∀ L1Q LlzhRβ∩HλE≤m8~`HK8(U≥$z(R∧ 4z0hP~9u~∧J9U≤
aQ LlzhRβ
HλE≤m8~`hP~9u~∧J9U≤
aQ$t⎇
)phP_HT∃∀1⊃⊂K]IλTr∧I~4lM:4¬$DTλ5-∃(Ye"∧→jD-∃*Z¬ h!Q#[[4 ∀u%λIB∧∃Y→D$-'$¬∀-JZ$u~ →e%∧ID∧LRλeB∧ 88U¬%4
∧~¬ y∀u$Z$∧|rλiEh)→e%≥Zπ hUλ:E¬∀q⊃⊂HK9hT,"
$⎇$X:DL\dλ∃~¬xT¬<LID¬-≤T T
∀8XB∧ :1PPLYzd,jε⊃E≥-
8∃0H↔:4
4T d,,HXB¬∀Xy∃≥$Z!PPLYzd,Jε∃Bt4
9D0H↔:E-∀d t42
I∧*∧→jD-∃*Z¬"¬;~5$,T
tDLHT¬$⎇X9∧LtqQ L$~!⊂HK4 ∀u%λI@hP→Yu4
ε⊃DLUJλD`h!~¬-≤∧ε∩dt→A⊂K\~
5<#∀λ∀t" ~¬≥<F!PPM
Z4Bβ∃IdL`Q!∃¬-9∧β
d→X∃≤X⊃↔4LL~92¬- yb∧,jJ%Hh!~¬-≤∧ε∩d0⊃↔5≤
hT¬$DT
∧~¬ y∀u$Z!PPL
*%U~¬ε∩HH↔8%-" ydeJ
)hP~
U≤Bε∃BD2⊃⊃∪L hD¬≤
hT¬$DT
∧_h!~¬-≤∧ε∩d ⊃↔5≤
hT¬¬∀X8U∃4XD∧ ≥1Q M¬Z9αβ
J!PPL J%U~λa⊂HK8∧R∧ Suh λ4h⊂(JH∪qDλA"B*
4rλε∃
⊃J!⊃.tp*h4h⊃AQB33jhαP#⊗ DD]aSh,P'Q⊂$g*∀""⊂*∪P#εEαfgk"SP#⊗$S*("&αD]a`U P$g∃("&εB∧fgk⊃dP_F !$)f⊃∧D]i⊃b`g!∪"P$g∃"i)*T*)FEαbdiεB∧fgk⊃P_V)Uh)`kβE''h∀'FE∧R))j⊂
*∀DDNi"b*T'⊂*'H!`f&⊃iεEεB∧E≥]NP*$"H aj*Pf⊂$g∃"i)*T*⊂$ S"&"i∀FEεE∞h"&⊂∪i"`∩FLOW
$PDLOV: MOT¬ ~APY! →M-(∩∩m'β-
↓(A'≡↓)⊃β(↓/
A⊃¬-αAβ8AβεAQ≡A+'∀~∀β≠=-αA(1∪≥)!⊃_∩∩w→+ ∂
↓∪≥)!⊃_A')¬π⊗A
Iβ≠
~(∪!+' A(I≥%_∩∩w%!'/λβ αε: α&BN<!IαVu*N⊗⊂hP&BV≤AαQ2tJ04(MαVN!¬!2&6
~,$%]~εJ∃∧J6εNZαVB≡p∧∧,uJ+⊂hP~
U≤B
EDd-hH∀⊂H↔:$B∧~4∧LUHZ%∃-
D¬∧~λ_E∩bλ∧∧ tD¬αJ∧i_Td%4 t40Q!∃¬-9¬"d HU5$_!⊂K]8~d*¬λ1PPM
Z4B¬EH@hP~
U≤B
EE⊂h!~¬-≤∧
Bd0Q!∀l]hYR¬"I→e%∧IA⊂K]8Iu∀* hU*∧→jE∧$D
∧|LjHU⊂h!→T⎇4T
Be∧IJ55 ⊃↔5∀-:Iu∀*λ_2¬ Q!∀U∃:D¬∧$Iz`HK8¬∩λYH∀∀IXq4td
⊃∪λ ZC"C!'nnh
R3tI~⊗(∪λZQ3λε$∩3UλZTU4
D∩⊂3HI⊃0TaQ@εE≥RdεTERRUPTAFTER NEGLY CBEATEDPAGE
λINTNXP: MOREMT,LV2SVT
MOVE T$@LEP
)βλVb
∀%⊃→%4↓(XQ($∩∩w∂∃(A)⊃∀A∪≥'Q%+π %≠∀A$BεQα≤
VN⊗ αR"∃∧:J&⊗0h(&R∃QαQ1β↓AAM8H%nεuIα&:$*aα>∩α& 4I~$,≥I→tr∧~4∧|XQ!∀ _T¬"b
8U$lU⊃⊂K]8λT L→D¬,
∀
Dj∧8(T
$Tλ∩¬∧_xRb¬9t∧ dD ∃~∧βrc!!(∩TJ:λ∩3JI4⊃B!↔su∩λZUr4hT⊂4hλ(1λ∪HZtc"A→3uQ$
∪∃F*uP
∧B]bf)QP)"iU'i"P∃εE∧b⊃a)%DBD]`g⊃⊂)"j∃i'⊂$S)j g∃&,FEβE→df∪"c`fλ&bfgT,P)"PbεE$S*$i"∞∧fgk⊃fP*ε∪+→)k∃∧D]j∀"`j⊂∩f EGAL MEMORY READAS MPV
;HEBE ON MEMORY PROTECTION VIOLATION, T SAVED ON FXP
INTMPV: MOVEI T0K!∪≠A,∩∩wQ+%≤A%≥)≡A¬≤A≠!X~∀β∃I'(A∪9)≠ $$∩wβ≥⊂A)% ¬(A→∪-
A∨)! $A≠∃≠∨%2↓ %%∨I&~∀~(w∪→→∃∂β_A5 ≠∨%dA/%∪Q
~¬∪9)∪/$h∪≠∨-∃~A(Y1,e'-P~∀∪≠=)'αAPXPK!%/%≡R$w ≡JM"∃α&u"=αJ,
⊃6>tbeα6,j>JdhP&*J≥!α&:$j⊗H4Ph)n&db⊗≡εbα>@4TJ:R&dyh&6⎇2⊗5α b2YJ≥2P4)[YeαN∧*∞&εbα∞"⊗≤Yα~>∩α∩⊗2≤AαNf≥"⊗%α≤
21α4zIαR,r⊗∞ε-→αR"
!α∩>r:Qα"
2∃α& h)mmZα∞εV≤)αN.M↓αJ⊗αJU∀pQ%e≤,T
%,∪_6⊂hP~94M∧d
D,tY
HK8∀¬$,h[βxh!∀∧U∃:D∧Lt→IsλH↔9d⎇∧UD∧tz
:∧,≤_→B∧≤~8PhP→
%∃R
EDLuJλ3⊂H↔:∧~[∀ t2∧→jD-∃*Z¬ h!→T⎇4T
Bbk∃
BHH↔8t-"λ_5%,→D∧LdHXt b →e≥%*X5$LyaPPL8→T*¬EK4$,H9¬hH↔:DD*λHTd≤∧ %≥M7qPPJ *%≥" →dLdv⊃⊂K\iz∧*bλ∀∧d,y~DLl~HR∧-*)u∩¬IλTph!→T⎇4Y∀¬"c1⊃∪L≤~Z4*∧∀
$-%Z)b¬$t %≥M56BαDiybl$~:∧d
∀
E%J⊃Q L z4∧LuJλ3⊂H↔8Te≤Tλ4
-8T∧
Q!∀l⎇hT¬"dJf%≥5A⊃∪]∀Z:D⎇∀T
@hP_HT∃∀1⊃⊂K]IλTr¬(ZE-∀d
Dz∧X→∀td→hPhPQ)∀tLIv∪PLYzd,J
EB-∧→→DxH↔9∀ddXx∀b∧zλU∀
I→tph!Q#\≤yYT|r XTl⎇+∀∧-∃)z"∧D→hDd-%D¬"∧~4¬¬-9λT"∧y`∧5E∧λ∀t"λ9tu$→→e~¬IλR∧-*)u∩∧)~@hS8jT$<T ∀u%λIB∧ hD∧U∃:D∧|4d
Dz∧XYT-∃!Q$LUIXU∪P→Yu$,Tλbdef*540⊃↔5≤
hT∧2∧→`∧\tzyb¬∧H_4(h!→T⎇4YT¬"dJf%≥#!⊃∪L J9r¬≤~hR∧4H_u_h!→T⎇4Tλbe\Jf%≥4eEDLUJλ3∃h↔:tD-(T∧2∧~5Be<λZ$*¬λ4∧M_Q!∀U≥∧
BdLhJ5-⊃↔5≤-JZα∧LjJ∧$bD
$-¬X)b∧LjJ∧$b →b∧0Q!∀l⎇hT¬"dJf%≥#!⊃∪\<ZD∧∀ 94∧4d_t∧∧MJ1PPLYzd,j
EDM¬:xC
De⊃∪M≥Iz$*∧XYT⎇∃∀λU∃∀z$∧∧MSTORE ACTUAL CONTENTS OF T
JRST MEMERR ;DHEN PROCESS THE MEMORY ERROR
;;; ASSIGNABLE INTERRUPT HANDLER
INTASS:
REPEAT CINTSZ,[
MOVEM T,LV3SVT ;SAVE AC T
MOVEI T,.RPCNT ;INDEP INTO CINTAB
↓JRST ASSIN1 ;THEN USE COMMON CODE
]
ASSIN1: SKIPN CINTAB(T) ;ASSIGNED CHANNEL?
JRST ASSRET ;NOPE, RANDOM INTERRUPT; JUST RETURN
SKIPG CINTAB(T) ;'CHANNEL' INTERRUPT (A CHARACTER?)
HALT ;NO, SOME OTHER TYPE, BUT NONE SUPPORTED YET...
MOVEM F,LV3SVF
MOVE F,[LV3SVF,,INTPC3]
MOVEM T,LV3ST2 ;SAVE INTERRUPT TABLE INDEX
JSP T,INTSUP ;SETUP INTPDL
MOVE T,LV3ST2
HRRZ T,CINTAB(T) ;GET THE INTERRUPT CHARACTER
TRO T,400000 ;FLAG AS INTERNAL
MOVEM T,IPSWD2(F) ;STORE ON INTPDL
MOVE T,LV3SVT ;RESTORE ORIGIONAL CONTENTS OF T
JRST CHNINT ;THEN PROCESS THE CHANNEL INTERRUPT
ASSRET: MOVE T,LV3SVT ;RESTORE ORIGIONAL CONTENTS OF T
DEBRK ;THEN RETURN TO MAIN PROGRAM
] ;END IFN D20
IFN SAIL,[
;SAIL NEWIO INTERRUPT CODE
;CALLED TO REINITIALIZE THE INTERRUPT SYSTEM
ENBINT: MOVEI T,INTRPT ;FLAGS,,INTERRUPT LOCATION
MOVEM T,.JBAPR ;LOCATION SO MONITOR KNOWS
SETZM INTALL ;DID A 'DALINT' LAST (ALL INTS ARE MASKED)
SETOB T,REEINT ;ALL INTERRUPTS INCLUDING REENTER
SETOI REENOP ;BUT MUST SET BOTH FLAGS
↓IWKMSK T ;ALL GET US OQT OF IWAIT
INTMSK T 9ALL ARE MASKED ON
MOVE T,[STDMSK] ;ELABLE STANDARD INTERRUPTS
↓MOTEM T,IMASK ;THIS IS CURRENT IJTERRUPT MASK
MOVEM T,OIMASK ;THIS IS ALSO THE OLD
MASK
INTENB T, ;TELD OPARATING SYSTEM WHICH INTS TO GENERATE
MOVEI T,REETRP ;BEENTER TRAP ADR
MOVEM T ,JBREL ;ALLOW REENTER AS MEANS OF IOC INTERRUPT
POPJ P,
;BEEJABLES INTERRUPTS AFTER THEY HAVE BAEN DISABLED BY DALINT OR DISINT
REAINT: PUSH FXP,T
AOSE INDALL ;DISABLED ALL INTS?
SKIPA T1∨∪≠βM⊗∩∩w9≡XA+M
A∂→⊂A∪≥)∃%%+!PA≠β',~∀α@↓'↔∪!∧A(Y∪5β'⊗∩$w →'∀A+'
↓π#%%∃≥(A≠¬'⊗~∀$@@A≠=) ~APY∪≠βM⊗∩w !∪&A∪LA≥∨.↓)⊃
A
+%% 9(A≠βM⊗~∀∪%≥)≠',A(∩∩m)⊃ ≤↓+≥≠βM⊗Aπ∨I% π(ααN⊗Q∧z→α&u"⊗JJ-αRL4PJN.&∧9αJ⊗,J:P4PIα*J≥!αJ⊗ J1D∀PJ6>Z,IαQ2≥α>B(hP&6>4*5αQbr*
>∧_4(&∧zAα~E↓2P4PJ*JN"αJ⊗⊗%⊃D$¬\2V∩≡*α¬αJ,*:R⊗⊂α&→α|r∃α↑
→αJ⊗α~T-≥HX@hU(X∀Ls↔!∃∧⎇∧λeEαJAPPM8ZD|@(⊂Q(Y3Uβ!!4∪t $∀ β!!"Nq ~p0SλT⊂3∪∧λU5 →4∪tJH3Uλ →U⊃4J*4∃∀aQL¬dfPieP$TP"gk⊃b⊂*'H'df`TeR⊂ S"⊂$fPieP$TP)bj∃h⊂*'H'"k@ AQRRELT MASK VALUE
DISINT: PUSH FXP,T ;SE WIHD NEED A WORKING AC
MOVE T,IMASK ;GET CURRENT INTERRUPT MASK
∪≠=(
⊗5¬!2>εl
N,$KZVB∩
"∃αyHB∧l~90hP_→d$≤T
Be\→jE∧
+I∀u% zedLjI∀dmI→e$u [Rβ\yiEJ∧→ID⎇~
I∧-≤T ∀u$Z*%-¬J1PPLYzd,j
ADLL~90HK9hU 4⊃04i1"B2)j∪4rd
α".jH3∪λ z⊃4P*I3Qh
;4u⊃)Q"B4hZ⊗S
(123JA".p)Jsh⊃ ~p3∪ zh∀Q(YU⊃4J1"B4 zλ⊃V
¬∃β"A~∪t∩D
β"AQNp
$∩iP)'Uj$g"H"$i`P&"iP⊂f"⊂$S*"i)∃h*)P⊃)'f@∪aaji∩dεG
;PHE FLAG IJTALL IS SET SAYING TO TELL THE BE-ENABLE BOUTINE TO RESTORE
; INTERRUPTS FROM IMASK RATHER THAN OIIASK
DALINT: PISTOP
POPJ P,
;HERE TO PROCESS AN INTERRUPT
;OPERATING SISTEM JUMPS TO HERE GITH ALL ACS SAVED AND SETUP WITH INTERRUPT
;STATUS; THA OBJECD IS TO SAVE INTERRUPT DEPENDANT DATA AND THEN REENABLE
;PHE INTERRUPT SYSTEM AS SOONAS POSSIBLE....NOTE THAT THIS MUST DISABLE
;INTERRUPTS DEPENDING UPON WHICH ONE WAS GENERATED.
;--INTERRUPT-- --DISABLES--
;MEMORY ERROR ALL EXCEPT PDL OV
;<ESC>I <ESC>I AND REENTER
;PDL OV ALL EXCEPT MEMORY ERROR AND PDL OV
;CLOCK ALOCK
¬
INTRPT: MOVE A,INTPDL ;DON'T WORRY ABOUT SPACEWAR BUTTOLS
SETZM REENOP ;NO ↑C/REENTER TRAPS NOW
MOVE B,.JBCNI ;GET INTERRUPT
PUSH A,B ;SAVE IJTERRUPT CONDITIONS
PUSH A,10 ;SAVE ARGUMENT TO INTERRUPT (FOR <ESC>I)
PUSH A,IMASK ;DEFERRED INTERRUPT MASK CURRENTLY ACTIVE
JFFO B,.+1 ;GET INTERRUPT NUMBER INTO AC B+1
PUSH A,@+1 ;STORE THIS ON INTPDL
MOVE B+1,SAIIMS(B+1)
MOVEM B+1,IMASK
INTMSK B+1
PUSH A,,JBTPC ;SARE ADR INTERRUPT EMANATES FROM
PUSH A,NIL ;SAVE DUMMY WORDS TO HOLD ACS D, R, F
PUSH A,NIL
α PUSH A,NIL
MOVEM A INTPDL ;THIS IS NEW INTERRUPT PDL POINTER
UWAIT ;UWAIT UILL RESTORE USER AC'S
EXCH F,INTPDL ;SAVE F, GET POIJTER TO INTPDL
↓MOTEM D,IPSD(F) 8π'β-∀Aλ~∀%≠∨- 4A$Y∪A'$Q $∩∩w'¬-
A$4∀∪≠∨Y
A$X9∃¬)! ~∀∪≠=- ~AHY∪!'AεQ R$s!⊃
↓% β_↓% )+I≤A!ε4∀∪≠∨Y ∩A$0Q R∩$sπ∨!dA∪≥)A _A∪9)≡A$4∀∪ 1
⊂A Y%≥)! 0∩∩w∀*NB>∀)αNR
"∃α≡2α→αεt!α&:%α∩04PJ6.Z,iα→2MαN→"∩H$%nαI∧,Rλ8∃4
λaPPLYzd*∧eI∃¬≤Hf"E∩⊃↔4<-Dλ$M" jTl∀X!PPLYzd*¬%J4 L→Z2D2⊃↔5$D~4¬<LID∧∀
hU*∧α30*9h
⊃D ⊂4h →β*⊂'∃fa"i
FE∧fSk"fP∀⊗$f`TeFE∧RdεTMSK R
DEBREAK ;FOW GG TM UCER DEVEL BUT NOT TO USER PROGRAM
JRST @SAIDSP(F) ;DISPATCH ON INTEBRUPT IN@ 04∀∩∀w5β∪_A%→) %I+!(~)≠β∪∪9(tβ≠¬∪_@f0~∀β∃I'(A M≠∪≥($∩w≥≡↓≠β∪_0A'∞A⊃∪'≠∪M&~∀∪)' A$1
≥3∪9(~∀∪U∪
'≠$XY,]M≠&~∀4∀w ∪M≠∪'&↓β≤A∪9) %%U!(~∃⊃'≠∪≥Ppλ&B-~!α~E↓2P4PJ6>Z*αQ2&u"B∩AQ LlzhR∧2I~¬≤$f∃¬"H↔:$-≥Iz$*∧~
"∧4H_u~¬It¬$Dz8R∧
D ∀u$Z*%-¬D
DL@1#"A→3uQ)T⊃K∩)X4rc!!23U Zrh⊃AQB4∪j∧∃ ⊃AQB4∪j∧∃ ∀AQB4∪j∧∃ ⊃↓Q@4∃*9λ∀ ¬
""'~Q5∃*)H∀⊂aQB4∪j (∃βεQ"B3)zQ3(
E∩3U
λ⊃α"'~Q4u zQ(∩)j∀⊃∪↓QB4∪j∧⊃R∀¬Jβ"B*9r4∪∧
Q12)jβ"B$ ⊂3∃↓⊃".qI@i⊂""P*ccdS!V⊂*∩$iP)R'jf"λ''j⊂∩ h("S⊂*g&⊃iiFEαDDD]Pgb"P∩iP''U⊂( dT b⊂!Si)"aU&,FEαDDD]H∀"$iRg*-b⊂f g*↔Ui"`Rg*∀FB∧iedT#P!"Qe'hεB∧P('T%⊂(⊗βEfgU"fP* )"biU*∧D]UbP'"Qb⊂ jλ&"`iU⊂'g"H aFEαfgk"H*⊗$g∃("&∧B]jabH*⊂ iH*$"P∩e*("∪εE∧`Q"⊂*⊗∀≠X∃XL∧D]kQP"biU⊂)"iQi+"P∃$"P)T abP∃bP+dS&⊂'"QbεE∧Sek"fH*⊗$g∃("&εB∧ijaλ*⊗)≠L∃ZDDNa*j∪ `k"H~⊂"*Sfh WORDS + 1 FOR PC
POP P,(T) ;PC IS THAT WHICH WE WILL POPJ TO
JRST REE@)Hb~∀~(w∪≥)∃%%+!PA⊃β≥⊃→∪≥∞↓%∨+)%→β&@! ∪'!¬)π⊃ ⊂A)=¬2&¬α≤
&∩NαH4*&u"⊗JIPJ6FR≥"Iαn
~∞&jd
9αεdb⊗≡εbα&*R-∩JVB"α"εM∧∩⊗⊗9¬∩⊗∞_Zd,"d
DDM4 ∃~∧→aPTLjHU∀t→D∧dM:∧∧-∃)z%ehβ"B)λ3∃β!! T⊂*)3U∞A→3uTi∀∀K
∧Z∩4⊂*%".qIH1h∃ λ5λ∩*4∀⊂4I~⊗(⊃**StC!!2TTjD∀p2)X4C"AQSR∪)→U∞B*9r4⊂$
K⊗i* 34∃KQ R3 Y3U∞A→3uTi∀∀K
∧Z∩5tI@TBE)Pdfbi∞∧fgk⊃P#⊗$S*("&αD]dg∃⊂("&λ( ∂INTER INTO F
↓MOTAM R,IPSWD1(F) ;S@)=%
A<B⊗J∃∧j⊗6⊗∃⊃α∞εrα~&:"α∀MJ1PPL**5"∧XYT-∃!⊃∪@:∀SphZth∪(Y3tV$λ4TSj!"C"G9⊃0Q$λStHπH4poI∀⊂3UλZTU4
A Q6(Y3Q∞A→3uQ$λK∩3JJ⊃∪α!↔p3U∧
⊃∪λ
r3UλZH∩3JIh⊃C!!4q5 (H∀C ~∀qqε%⊃J"'_StPhT⊃2∃λZSP3∧λp3∪↓QLb3)zS(∀EI4∀uhFJ⊃J!↔qq5∧π⊃4pgi(⊂4Ht
⊂∪j95∩5HT⊃StIT⊃sS ∃#"Na_p23λT∀K &Vb".iyS⊗(λ9⊂4P(:⊃4Td
4λ∃ t -ed ⊂5Q$ 103I→β#FE∞DP ∀DZA B1$∩∩w→≠%π
↓$A)≡↓5β%≡4∀v∩@↓)→∞AHXh``@``∩∩m
→β∞↓)⊃β(↓)⊃∪&↓∪&Aβ8A∪≥ ∃%≥β_↓ββ→_4∀v∪≠=)β~AHY∪!']λdQ $∩w% M)∨%
↓β%∂+5 ≥(AQ_
α∞Dr&*PhP&∞2∀∩~$∀PJ*JN"αε":LrP$%\2V∩≡*αR"∃∧~"ε:t*1αεu"⊗JJ-αP4(hQn 4Xp∧LUHZ%∃-
D∧l
90∧)5∀k∧ 3Q⊃+λ1λ⊂K∀⊂u4J(3Uλ →U⊃4J*4∃λ J30Q*!"Tp)→34nA⊗λ∂hε∧∂h ∧πh λ↓Q@23JJ∪uB!⊃.s0)→λ∩3JH4TU*
β"B&∧∂h ↓Q@∧dg∃('k∧BD]`⊂AR EBROR2 ONLY ALLOW PD@_A=(∩∀∩5∪≥)π1⊗Zb∩$sπ ∨
⊗Aβ≥PpAβ→1∨ ≥α b1α>$B⊗JLhP%A↓z↓A↓⎇β↓↓⎇↓H%n:⎇!αVN,!1α&ESC>I: ALL EXCEPT <ESC>I AND CLOCK
0 ;CHANGING QUEUES, NOT USED
INTPOV\INTILM\INTNXM\INTPAR\INTPOV ;PDL OV: ALL MEMORY ERRS AND PDL OV
0 ;PDP-11 INT, NOT USED
INTPOV ;ILM: ONLY PDL OV
INTPOV ;NXM: ONLY PDL OV
0 ? 0 ? 0 ;OVERFLOW AND OLD CLOCK TICK
;DISPATCH TABLE, INDEXED BY INTERRUPT NUMBER
SAIDSP:
REPEAT 6,INTERR ;INTERRUPT ERROR, THIS CANNOT HAPPEN
MAIINT
REPEAT 2,INTERR
PARINT ;PARITY ERROR
INTERR ;CLOCK INTERRUPT
INTERR ? INTERR ? INTERR ? INTERR ;VARIOUS IMP INTERRUPTS
EYEINT ;<ESC>I INTERRUPT
INTERR ? INTERR ? INTERR ;CHANGING QUEUES, UNUSED, UNUSED
PDLOV ;PDL OV
INTERR ? INTERR ;PDP-11 INTERRUPT, UNUSED
ILMINT ;ILL MEM REF
NXMINT ;NON-EXISTANT MEMORY
INTERR ? INTERR ? INTERR ;UNUSED, UNUSED, OLD CLOCK INT
INTERR ? INTERR ;UNUSED
INTERR ;FLOATING OVERFLOW
INTERR ? INTERR ;UNUSED
INTERR ;INTEGER OVERFLOW
REPEAT 4, INTERR ;UNUSED
] ;END IFN SAIL
IFN D10*<SAIL-1>,[
SUBTTL DEC-10 ONLY NEWIO INTERRUPT CODE
;***A NOTE OF CAUTION
;WHENEVER THE INTPDL IS TOUCHED, IT IS DONE SO IN A CERTAIN ORDER OF
;INSTRUCTIONS. THIS IS NECESSARY TO PREVENT TIMING ERRORS FROM SCREWING
;UP THE PDL SLOT ALLOCATION (THIS PREVENTS SAVED AC'S, FOR EXAMPLE, TO
;BE OVERWRITTEN BY NESTED INTERRUPTS). DO NOT CHANGE ANY ORDERING OF
;THIS CODE WITHOUT METICULOUS CHECKING TO SEE THAT RANDOM, ASYNCHRONOUS
;INTERRUPTS WILL NOT CAUSE TOTAL LOSSAGE.
;INTERRUPT ENABLING/DISABLING
;ENABLE NORMAL INTERRUPTS, CALLED AT STARTUP
ENBINT: MOVEI T,REETRP ;REENTER TRAP ADR
MOVEM T,.JBREN
MOVEI T,APRTRP ;THIS LOCATION FOR ALL APR TRAPS
MOVEM T,.JBAPR ;INFORM TOPS-10 VIA JOBDAT
MOVEI T,STDMSK
MOVEM T,IMASK ;THIS IS CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;ALSO IS OLD INTERRUPT MASK
SETOM REEINT ;REENTER INTERRUPTS ARE OK
SETOM REENOP ;BUT MUST SET BOTH FLAGS
SETZM INTALL ;WE HAVEN'T DISABLED ALL INTERRUPTS
APRENB T,
POPJ P, ;NO OTHER TRAPS VIA THIS MECHANISM
;RE-ENABLE AFTER DISABLE INTERRUPTS
REAINT: PUSH FXP,T
AOSE INTALL ;DISABLED ALL INTS?
SKIPA T,OIMASK ;NO, USE OLD INTERRUPT MASK
SKIPA T,IMASK ;ELSE USE CURRENT MASK
MOVEM T,IMASK ;THIS IS NOW THE CURRENT MASK
APRENB T,
SKIPLE REENOP
↓ JRST REAIN2
SKIPG REEINT
JRST REAIN1
REAIN2: MOVEI T,CPOPJ
MOVEM T,.JBOPC
POP FXP,T
JRST REETR1 ;FUDGE A REENTER IF ONE WAS RE@#U ') ⊂~∃% ¬∪≤bt%' )∨4A% %≥(~∀%' )∨4A% 9∨ ~∀%!∨ A→1 Y(4∀∪!∨A∀A X4∀~∀w⊃∪'β¬1
Aβ→0A¬+(↓∪≠!∨I)β≥(↓∪≥) I%+!)L~∃ ∪M∪≥(t%!+'⊂↓
1 YP~∀∪≠=-
A(1∪≠β',∩∩w∂∃(Aπ+I% ≥(↓≠β'⊗4∀∪≠∨Y ~A(1∨∪≠βM⊗∩∩wI ≠ ≠ $A∪PA
∨$↓% ' Q∪≥∞AA+%!∨M &~∀%β≥ ∩↓(Yβ 9!∨,∩$w↔≥→dAβ→→=*A∪≠A∨%)β9(A∪≥Q %%+A)&~∀%≠∨- 4A(Y∪5β'⊗∩$w)⊃∪LA∪&A
+%% 9(A')¬)
A∨_A'3'Q ~~∀%' )54A% %≥(∩∩m≥≡A%∃ ∃) HO&A≥=.~∀∪¬!% ≥λA(X~(∪!∨ ↓
1 YP~∀∪!=!∀A 0~∀~∀m ∪'β →
Aβ1_A∪≥Q %%+A)&~∃⊃β→∪≥Pt∪!+M⊂A
⊃@Y(~∀%' )∨4A∪≥ ¬→_∩∩m⊃β-
↓ ∪'β → λA¬→_A∪9) %%U!)&~(∪' )i∧A(YI ∪≥P~∀ββA% ≥∧↓(X~∀%!∨ A→1 Y(4∀∪!∨A∀A X4∀∩∀w¬!$A Iβ A⊃¬≥↓→∪9∞~∃βA%)% h∪' i~A% ∃≥∨ ∩$sβ¬'=→+)→dA≥≡AyεW% ∃≥) $↓∪∃) I%+!)LA≥∨.∧~∀β≠=) ~APYβ!%M-(~∀%' )4↓(X~∀%β!% 9∧A(X$∩w≥≡↓∪∃) I%+!)LA +¬%≥∞A)Iβ A'∃)+ ~(∪≠∨-∀A(Y∪9)! _$∩w+π∀A(AβLA)⊃
↓∪∃)!⊃_~∃%∃!ββ(hXA!U'⊂A(0∩∩vD↓∪∃) I%+!(↓/↔% LAβ≥λdA →
% ⊂A/∨%⊃&~∀∪A+'⊂APX]∃¬Q!ε∩∩m∪⊂~R-∩JVB"αB 4PJBVN@αQ2⊂HI`≥≤~hR∧ 4z2∧
4 ∃%~ →e$-**U¬"
yu,dDλDxh!~¬-≤∧
Be⊂Q!∃¬-9∧¬"daQ LlzhTj¬EI∀u%λI@hP→Yu4*λEDLL~90HK:I∧M~ ~2∧<y→d:¬It∧<z →b∧LjD∧l
96∩¬<z(@hP→Yu$,TλBdM
8D3
E⊂hP~8U%RλE@hP→Yu4
λeBtT(9dHH↔8t-"λ_5%,→D¬¬∀x8U≥≤z$∧∀MJ1PPMJ)d*∧eH∃αuλ~ hP∀
DdzλEBB- ~∧
∩⊃⊃∪@:⊂4R*K(⊃4J)tC"A~∀SQ$λK⊂4¬j∪uB!↔t⊃∪∧ uOc!!(∩TJ:λ ∀λI∪uC!!5∀SHT⊃K⊂*¬R3∪!⊃.p∃*((⊂⊂(x(⊃4J)tOh¬
r∪u)Hλ∃∩ ~h⊂Q$ 4∃Oe⊃"B(
I∪h⊃¬E 4∩*zSj#!!5∀SHT⊃K⊂*¬SV∪!⊃.sSie16∩*:⊂3U∧ 133j+#"B$
∀ShλE 4∩)Z∃C"A→3uQ)T⊃ ∩*
uq %
#"A→3uQ$
⊂4
*uUβ!!2U3* H⊃ X314J!"B3jZ∀q∀D p4pi≠H↔∃)jQ0shyR6Q(D⊂4∀D 3U⊃**U4∃ K#"B)λ3∃β!!"I∀λI∪uNA→3uQ$
⊂4
*uUβ!!2TTjD∀⊃∪ zC"C!'q∩4iY4thλ→H∩3JH4TU*
β"Q
923Uπ!4∃4i∧⊃V∀¬Jβ"B)YuQ(
E∩3U
λ⊃β"A→3uQ$λK∩4
8⊃L*
E".tHZu∪tHT⊂4∀DλS⊂1j4∃∪h
I∪tq$λ5λ∩)j⊃4TJZ∃λ∃ →1#"A→3uQ)T⊃K∩)X4rc!!04∀HYPH⊃EA"B4 zλ∃ λa"B4 zλ∃
!"B4 zλ∃ λA"B4
Zrλ∀¬E∃
"!↔tQ5
ZSH∀λ1"B4 z∩(∃¬F#"B)YuQ3$
∩3JJ⊃∪α!↔tQ4jItQ( →U∀⊃ A"B4 zλ⊃V
¬∃β"A~rr4 D∀Q1)→Uβ"A∀∩⊂3
A"".hitH⊃λXU1qi→Qkλ
I∩4h
9∪u3λD∪Su∧ ⊂4∀λYH∃3IH4tc!!"""'_qq⊃$ 4h∪Izλ∀⊂)~Q1λλ→tTQ(:∪⊗(¬λ∩4r)j⊗q⊂)I3U↔%zQ02)j
#"A~rr4λt∀Q1)itβ"A∀∀∪t $∀ β!!33uHY(∃β
(10uJA".uhT⊃Q1(D⊂5 H04u∧ sQ(λ_c"B)YuQ(
E∩3U
λ∪α"':4q(
D⊂4h
I⊃(∩)j∀⊃∪↓Q@01λD∃ ∀Fv
l$↓⊃.p bH&jijλ)"abT+"P*∩"P!h⊂abP+QP+df∪⊂'"bQ∧E∧fSi"f@∃⊗$g*∀""εEαija⊂∃⊗)≠X
ZDD]P*j⊂&⊃`k"P
⊂"*fSlP ↔OR@S + 1 FOR PC
POP P,(T) ;PC IS THAT Tπ⊃βπ A/
A]∪⊃λAA∨!∀AQ≡~∀∪)%'(AI )$D~∃:W∃≥A∪→≤Aλb@Ty'β%_Zb|4∀~∀wQ⊃αA
=→→∨/%≥∞Aπ= ∃αM→α~>∩αR>B~iEAα r⊃αN J04*L29α⊃ ↓2l4SZ"εJ*α~>I∧ αVN-⊃α∞"
∩ε∞R-⊃α&:$*JJV¬!1α6 Z∃αεrα&:R≥"ε∞-∧2Jε6*αε:⊃∧~ε21∧~":&u 4*V≤B&:QPJN⊗RTiαJ⊗,J:P$KZ∩>9=!αε2dzUαz~zJ⊗⊗u"⊗JM¬"=α≡zαR"J⎇*≡ 4PJ6>Z,iαQ2∀*⊗NZ H%n↑*α:⊗⊗"αεQαd*εNQ∧z:¬α _4(εlzZ¬α b&*R∧"0$%]*N∃α αεMα$B∃αεu"B∩0hP&ε∩ αQ2I;↓-E@HIn6V≥!αN⊗"α&:R∧"1αRzαε~R-⊃α&R~αJ⊗εbαVN∃¬~=αRD
P4λHH$%nα(T≥-*9∃4
→e$-**U¬%4
U≤*λI∀44X(Tu"
:D ≤4λ∃∀ ~1PPLYzd,j
ADLuJλD`h!~5,∩
AE∪;¬6@HK:xR¬<→IB∧\XZα∧
λJTlm∀λd⎇-$
t⎇∀J1PPM
Z4B¬EK3αbH:∧⎇∧+Q∪]∧4λdd z4βα∧~4¬$D[∀∧l
∀λt-"
(U≥$z(T"∧+∀∧U∃:Dβ∩`Q!∃¬-9∧¬"dA⊃∪]≤~hR∧ 4z2∧
4 ∃%~ →e$-**U¬"
yu,dDλDxh!~¬-≤∧
Be⊂Q!∃¬-9∧¬"daQ LlzhTj∧EI∃¬≥xF"E"⊃Q LlzhR∧"I→T
≤1⊃∪]¬ZD∧|dD ∀l
94∧Lr
yu∀"ε∀∧l
91PPLYzd,jλEDM¬8Hc
EE⊃PPLYzd*¬EJ$,-:j@hP~8U$|T
$,,izhP~8U$|T
$,,→j@hP→*%≥"λ9∧tLjAPPh!Q#]∀XYe$-$
E∀
∧λ∀%⊂Q*$,-J*βPL→z4:¬(XTt⎇↓Q J∧→z4d*λ(T,LjA⊂K](XTu$Z$∧ dIzt,#qQ Jα *%≥$dλαtT)z∧_H↔9d⎇∧UD∧4d_t∧ tDλtz∧yaPPLYzd,j
EE∀,Z:e H↔:t*∧hXT"∧~D∧d,~:B∧|hT∧ _Q!∀l⎇hT¬"d→jE∧$A⊃∪]-8T¬"∧~4¬$DT ∀u%λI@hP__D"¬EJ#;α6⊗HK9ZU≥"
8U"∧→jE∧$D
Dz∧_jD-∩ ~E~¬(X∀b¬Z8R¬≤t
DD
AQ HH⊃↔5∀,:Z%≤MhT∧LuHZ%∃-
J2¬-8T∧$LhhU∀,jD¬≥$_92∧
(X∃_h!→T⎇4YT¬"d→jE∧$AQ M≥X$¬"e&vα[ ⊃↔5<*
y∀db 8T-αλ∀∧%,Y[∩∧4zZ"¬<z(E_h!~¬-≤∧
Bbt()u∧_⊃↔4LuHZ%∃-
D¬∧_Q*$,-J&∪PM
Z4B¬EH@HK:8∃4*λ_2=~λ~2∧MJ4∧LuHZ%∃-
D¬<⎇YHB∧$qQ M¬Z9α¬"J!PPM
Z4B¬EH`hP~8U%TT ∃¬≥xF"E"⊃⊃∪\4z(4*∧X~4Z¬It¬T-)t∧
~ ~2¬-8XB¬≥λX4L IK⊂hP→Yu4*λEDLl~90HK::D⎇∀T ∀l
94∧
~
yu∀#∀ T
≤1Q LlzhTj∧EI∃¬≤Hf∩E"⊃Q LlzhR¬"J(T-≥jAPPM8ZD|j
(T,tz↓PPM8ZD|j
(T,LjAPPL**5"∧9 dLuAQ%hK8Yd"∧_ib∧#⊗↓PP`h!Q#[[4
tD,d
DD
→e$-**U¬" x4≥-*5B∧ :4∧"b
%B∧ hD∧2∧λ~d*∧(XTr¬8~d,"aQ#[[4λ%J∧9ye4,jI∀|rλ→b∧LjHU∃∃Z
B∧D→hDd-$ T⎇4Z4¬$DT ∀u%λIB¬∧y→e$-!Q#[[4 ∀u$tλbb∧xZE~∧∀
d d_D∧5E∧
∧|LjHU∩∧→jDj∧k
αb∧→hB¬¬Z9∧-~
I∧*∧yH@hS772∧≤yjD,uJ4∧|2λk¬α∧yjDz¬Iλ∃"¬λIBphTANDARD INTERRUPT EXIT
;;; WILL RESTORE FXP AND D+R+F, AND DISMISS THE INTERRUPT.
INTXIT: MOVE FXP,(FXP) ;POP FXP,FXP
SKIPN NOQUIT ;CHECK FOR USER IJTS STACKED BY INT HANDLER
SKIPN INTFLG ,SEE CHECKI
JRST INTXT2
SKIPE GCFXP ;HOW CAN GCFXP BE NON-ZERO WITH NOQUIT ZERO?
.LOSE
PUSH FXP,IPSD(F) ;ARRANGE TO RESTORE D AND THE PC
PUSH P,IPSPC(F) ; (INCLUDING FLAGS!) AFTER CHECKING
PUSH P,CPXDFLJ ; FOR STACKED INTERRUPTS
MOVEI R,CKI0
MOVEM R,IPSPC(F)
INTXT2:
IFN D20+D10, JRST DSMINT ;DISMISS THE INTERRUPT
IFN ITS,[.CALL INTXT9 ;RETURN PC IS ON TOP OF INTPDL,
.LOSE 1000 ; AND ALSO THE OLD DEFER WORDS
INTXT9: SETZ
SIXBIT \DISMIS\ ;DISMISS INTERRUPT
5000,,D←6+3 ;POP ACS D, R, AND F FIRST
400000,,INTPDL ;INTERRUPT STACK POINTER
] ;END IFN ITS
;;; STANDARD LOSING INTERRUPT EXIT
;;; RESTORES FXP, AND D+R+F AS INTXIT DOES.
;;; ALSO EXPECTS A .LOSE ERROR CODE IN R.
INTLOS: MOVE FXP,(FXP) ;POP FXP,FXP
INTLS1:
IFN D10+D20, JRST DSMINT ;DISMISS THE INTERRUPT
IFN ITS,[.CALL INTLS9
.LOSE 1000
INTLS9: SETZ
SIXBIT \DISMIS\ ;DISMISS INTERRUPT
5000,,D←6+3 ;POP ACS D, R, AND F FIRST
,,INTPDL ;INTERRUPT STACK POINTER
,,IPSPC(F) ;NEW PC ;IN ORDER TO SPECIFY
,,IPSDF1(F) ;NEW .DF1 ; THE .LOSE CODE, ONE
,,IPSDF2(F) ;NEW .DF2 ; MUST MENTION ALL THIS TOO
400000,,R ;.LOSE ERROR CODE
] ;END IFN ITS
;;; EXIT INTERRUPT, GOING TO USER INTERRUPT HANDLER.
;;; ARGUMENT FOR THE UINT ROUTINE IS IN D.
;;; PDLS ARE IN GOOD SHAPE BY NOW, OF COURSE.
XUINT: SKIPE GCFXP ;BE EXTRA SURE ABOUT THE
IT$ .LOSE ; GOODNESS OF THE PDLS!
IFN <D10+D20>, HALT
;;9; POP FXP,FXP ;AT THIS POINT SHOULD BE SAME AS SUB FXP,R70+1
MOVE FXP,(FXP)
PUSH P,IPSPC(F) ;PUSH INTERRUPT PC ON STACK FOR UINT
PUSH P,CPXDFLJ ;ARRANGE FOR AC D AND FLAGS TO BE RESTORED
PUSH FXP,IPSD(F) ;@USH AC D (BEFORE INTERRUPT) ONFXP
MOVEM D,IPSD(F) ;CAUSE D TO SURVIV@
A !
A ∪M≠∪&~)∪
≤A⊂b`WλH`Y6~(∪≠∨-∃∩AλYU∪≥(∩$s∃ .↓!ε~∀%≠∨- 4AλI∪A'!εQ_R∩w'Q∨%
A]⊃β%
↓∨→λAAεA/ 9(~∀∪)%'(A⊃'≠∪≥P∩∩w ! ∀A %'≠∪'LA)⊃
↓∪∃) I%+!(4∃:∩∩m ∃λA%
≤AλD`Wλd@~∀
∃%
≤A∪Q&Y6]
β→λAa+∪≥λd~∀α@9→∨'
b``@4∀~∃1U∪≥(rh∪' h~∀β'%1¬∪(↓9↓∪'5∪'8∩$w ∪'5∪'&A%≥) ¬I+!(~(∩@@j@``@1d"⎇Y-_H%nB⎇↓αε∞~α⊃1α∩aαε: α→α~M∩NP4PI↓↓↓α↓↓12LrRB∩`H%nεu"⊗JJ-αQαN$
∞-α∧z&*R-⊂4(¬α↓EAAαa2V&u $%nt*UαB_h(%↓α↓↓↓↓bbRRf$1D$%\r⊗]↓t"→D∀PIQAAβ↓A12%"f∩→⊂H%n:-9↓:∩3⊂4*THIf⊗:"α&~9∧JRL4P04λhQmmm∧j⊗6>∃Iαε:"α6B∞|"∃α⊗∃∩>JMRαBεJM"e1α¬*J∃1∧jBY1∧J2>Aph)mmZαεNN,j∃α:zα6>J*αR"εrα>:∃∧BεBB,rMαε"α¬αRLj∃8∀Ph*6⊗l*JIhhR&Q⊂JrNVN-!αm:∀RB
1dRB∞N
2t4(Lj>Z∃∧12&:%α∩04PJ6>Z*α⊃2~E4(&≤Z&B∃∧:∞~bh(%αlzZ∃α5BA2≡≤2b@4PJBVNBα~bAd 4(εlzZ9α∩b&BN<!E"→HIfR"M→αN⊗
*⊗:∞*α.&2e→αR"*α2>]lzJ∩⊗⊂h(&εt"∞¬α∩b&BN<!E"→HIeα
M!α~J|iαR"*α&:R-∩JVB"α↑.J h($$HIeα~⎇⊃α⊃Eαaα↑&daα∞>u"ε&9∧
BIα4bε≡M∧z→α6-∩&P4PJN.&∧)αH$HIn2>≤)α&→∧j>J∃¬""ε9∧z:¬α∀JQα↑
→αN⊗ h*&Q I↓:2⎇~∀4*L29α⊃ ↓.⊃Iαaα"εe 4(εlzZ¬α⊂b&BN<!E"→Hh(&"∃∩iα⊃dJBNB~B→$4TJQ⊂&≤
&9α bR"&∃"e-THIn∩∩"α∩>⊗~naαLqα2≡≤
R&>p↓MP4TJQ⊂%∧RJNQα"b2>≤(4(&$b:¬α⊂a!⊗BKbBεIrH%n↑
→α&Q∧ αBε∀JReα-∩J>Ixh(%αU∩NQα∧
J⊗J⊂h(&Rdr∃αIbA⊗B%e:J=yHInNJM"∃α&u"=αJ,
⊃6>tbe|4PIα*J≥!αBV∃α≡$4PJRJ:*αI1⊗∧Ir&2{p$%nLb2⊗≡ aα>B-∩εR&|q|4(Jα*JN α&">∧*H4(M"J:9¬⊃1⊗BKb6BYpH%n6,j>JE¬αJ>R,~QαZLz2εRLz9|4PI↓:Z bV∀$HIf:={y⎇α↑D
Qα"
αB⊗:,!⎇⎇|hP&∞εL)α⊃2,∩⊃D∧KZ2⊗Q¬~B⊗∞∧"1αJ-~R>J
"&>→∧BεBB,p4(¬∧RJNQ∧jBZ⊗∃⊂$%M∧*Z⊗9∧J→α>t)αN2⎇!α≡>"αε2>∀∩⊗J⊗ h(&ε⎇→α&B≥α
"→HH%n
,jAαB~αBεN"α>~~,r∩&::α&:N%∩V∞RLz8 (!→%∃≥D ∀u% ~@hPQ)U¬4X*#@M99∃∧
λEEM,→YU¬5QQ%¬-(Z%∪P∀ T⎇4Y∀∧"eY→U=∀qQ LU*:B∧lYXU∪(Q!PTLIz∧-∪!⊃PTLid∧#∪¬K0hP~94M∧d
D,TY
hP∀ %∃≥D ∀d⎇
&⊂hS4
DDM4λ∩∧≥*Xe%Jλ*U"∧_HU
,~HR¬$λYu∃J xb∧-))Uα=1Q LDJ+"¬∩F¬∧"HQ!∀ _T¬∩c6&β;β↓⊃∪\-)*TmβqQ J∧**5"∧→Iu¬∪⊃Q LDJ+"¬∩EV∩D"⊃Q L≤→_R¬∩F⊗β#β∧↓⊂K\*;∃≠xQ!∩∧U*:B∧LIz¬∪λQ!∀E∃+$¬∩c¬λBHh!→¬∃∀T
"dM
:∧~De⊃⊂K\9It∀∀Z ¬∀-:H∃∃"λ_D%∀Z:0hPα2TJ:λ∩3JK∩5β!)3∪t
&.C"KQ".q)hλ∩1Id⊃ L↓QB4ri~⊂(⊃¬Ku23)→⊃w#!*⊂4Q**NB( YuQ2$λ ∃2)Z⊂4C!)131*&.B2
*VH∀EI3U∀λIα".iX0r∩)h(⊃4J)tH
Y⊂5
Ih⊃∪gq"B0h→3H∀EI3U∀λI
s∩*
p5B'→1H∃ λαP"i∀'i⊂$⊂h("g⊃b⊂+dU$$g AJ INTERRUPT SERVER
↓ SKIPN VMEBR ; OR IF USER SUPPLIED NO ERROR FUNCTION,
JRST MEMER7 8εAπ%¬ A∨+PA¬βπ,A)≡A⊃ (~∀%≠∨- $AλHb@````!λR
∀%⊃%_A⊂Y∪!'AεQ R4∀∪!+M⊃∀A
a XI∪]β∪(~(∩A∃%M(A1+%≥(∩∩mπβ→_↓+' $↓∪≥) I%+!(↓⊃β≥ 1 $~∀l∪∃%'PA∪≥)a∪(∩∩m≠β2AI
P⊗∩zα2>NLr≥α&u~RI1∧∩VQα≤yα↑"
!|4(HH$%m¬""εQ=→α¬α4*εRV∀)1α:⎇!α¬α∃*≥84PJε:∩Jα⊃1];84*6,j⊗I]Ph*&~rα&BMeX4(εE∩Jiα⊂b6⊗6-⊃a"⊃Hh(&*∃~Qα&u"2>LhP4*6,j⊗IaPh*>~5~⊗Q↓jp4*VLjBεISP%E-tb`∩αZ ∃∧
!Q%,LY→D{S!⊗∩ZtK$α-∧→→Dxh*Y∀m=)w#PK∃1deR∧Z∧M=)qPU,→YU¬3'!∪
ZiK"α- →U¬0Q)t458ZBβQ!PR% Iu≥#!∃e4 JXR¬\~84MR G!Z¬→zU∩↓2s15B Iu≥"β2u¬∀x8T,!d Ehh!→%∃≥D
DDM*K∩[(⊃↔4d-D
DD
β;α¬∀X¬∃*)H⊂sj*Q0u K#"C!$⊗∪∪j8.B3)zQ2(
% ⊗∪ Zuα"'a`jiQP NTERRUPT DURIJG AN ≠X
MOVEM R IPSPC(F) ; TO GO TO $XDOST (CROCC)
JRST INTXIT
] ;EL¬λA∪→≤A∪)L~∀
∃%
αA∪Q&Y6~(∪≠∨-∃∩AαY5 ≠ $`QλB∩m)%β≥M
$AQ≡A∂≥∀A∨ AQ⊃∃αd*IM≡~α
⊗2⎇84(ε-B∞!α
b&BN∧→" $hP&ε:$Iα¬1kλ4(εU∩NQαLrRb& h(4*l*6⊗ICP4*>42N⊗Qαi84*,J6Bε∪Qiα∩-⊃Mαn≤Jb
&"αrB
∧
Qα↑DJ≤B XTl]+∀¬∧
)~EJ∧Z*$m∩ x4≥4TQ(D7↔#!*232)InNH H4Lh :r6⊂I~λ↔∀λ4∃r5 ∧∩3∪λXp3λ →Tu∀JXu∩3iD⊂sqλT4ε.FB*dfkT']≥⊂∪"i→P⊗idl!∩j⊂.(⊂P j∃d adλ j*"Sh*⊂*∪P+i$U P$g∃'P(*T"P QbPn.CE*dfSh+≥≥λ&"i→H-idl⊂$j⊂.∀!P#dU$⊂&bSgi,P∀)'j"Ph$ggλ+$gf⊂j ggλn.FE∪c#!bU⊂_εE↔DYbg⊃⊂'c⊂∩c"P$U)FEεB≥]]P∩c'⊂" X⊗-FB≥]]Pαgj`∀STR @MEMER_(@! ;GIVE ERROR IF USER DOESN'T WANT IT
;;; EXIT 1,
;;; JRST.-2
9;; ] ;END IFN @10
;;;
3+; IFN D20,[
;+; HRRM 1,MEMER8(D! ;GIVE ERROR
;+; PSOUT
;9; HALTF ;@)! ≤AπQ≠ A a π+ %∨∀A≥%π →24∀vvv↓:∩∩w∃≥⊃αL29α⊃∪4)m[Y4)[Yeα_ib∧#⊗¬4#∪¬K0hS572∧lYXU∪C!Q#[[4 t458ZBαjaQ#K[4
TLmλ~#@'Vp4h94H↔πz_<Z.O(→4N-|H∩-d~[xAQNjnd ↔#"G↔nh∃)→23∪gπVp4h94H↔πy;≠→,\9λ⊂↔\⊂2|2Xzz2rβE→]MH..FE∞]]P*Rfki'N≥-`iPdi⊂.∂ky4z→P4w:≠P92pY⊗ww6≡P6rf[y<FE∞]]P.↔FE≥]Nβ UIMMPV::[ASCIZ \?Memgry proTection violation
;;9 \]
;;; OFFSET 0
;;; ] ;END IFN D10+D20
¬
;+; I/O CHANNEL ERROR HANDLER
IFN ITS,[
IKCERR: MOVA F,IJTPDL
MOVE R,FXP
SKIPA GCFXP
MOVE FXP,GCFXP α PUSH FXP,R
.SUSET [.RBCHN,,R]
↓.CALL SCSTAT
↓ .LOSE 1000
,IPSPC(F)
MACROLOOP NIOCTR,ZZI,* ;ZZI MACROS DEFINE IOC TRAPS
SKIPL R
JRST IOCER8
IKCERA: HRRM R,IPSPC(F) ;CDOBBER RETURN PC
HLRZ R,R
CAIN R,400000+D ;WANT TO STICK IMC ERROR
MOVEI R,400000+IPSD(F) 9 CODE ANTM SPECIFIED AC,
CAIN R,400000+R ; BUT MUST BEWARE OF D AND R
MOVEI R 400000+IPSR(F)
MOVEM D,-400000(R)
JRST INTXIT
IOCER8: SKIPN IOCINS ;ANY USER IOC ERROR HANDLER?
JRST IOCER9 ;NOPE, LET DUPERIOR HAVE THE ERROR
MOVE R,IPSPC(F) ;PC IN R
;ERROR CODE IN D (SEE ABOVE)
;CALL USER WITH PC IN R AND ERROR CODE IN D.
;THE USER'S ROUTINE MUST NOT MUNG ANY AC'S OTHER THAN R AND D, THOUGH THE
;STACKS MAY BE USED. IF THE USER'S INSTRUCTION SKIPS, THE RIGHT
;HALF OF R CONTAINS THE PC TO DISPATCH TO AFTER THE DISMIS, AND THE LEFT HALF
;OF R CONTAINS 400000+<ADR IN WHICH TO STORE ERROR CODE>
PUSHJ FLP,@IOCINS
SKIPA
JRST IOCERA
IOCER9: MOVEI R,1+.LZ %PIIOC
JRST INTLOS
] ;END IFN ITS
;;; INTERRUPT FROM I/O CHANNEL.
;;; PRESENTLY ONLY TWO KINDS ARE HANDLED:
;;; TTY INPUT: INTERRUPT CHAR TYPED.
;;; TTY OUTPUT: **MORE**.
CHNINT: MOVE F,INTPDL
MOVE D,IPSWD2(F) ;GET WORD TWO INTERRUPT BITS
CHNIN2: MOVE R,FXP ;FXP MAY BE IN A BAD STATE IF
SKIPE GCFXP ; WITHIN GC, SO RESTORE IT AND
MOVE FXP,GCFXP ; THEN PUSH ITS OLD VALUE
PUSH FXP,R ;REMEMBER, PDL OVERFLOW ISN'T DEFERRED NOW
IFN ITS,[
MOVN R,D
AND R,D ;R GETS LaOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [.SIIFPIR,,D] ;PUT ANY OTHERBITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1 ;FIND AHANNEL NUMBER
MOVNS R ; FOR SOME PENDING
↓ADDI R 43 ; INTERRUPT BIT
PUSH FXP,R ;SAVE CHANNEL NUMBER
SKIPN R 3CHANNEL 0 ??
↓ JRST CHNI2 ;YES, THIS CAN HAPPEN IN STRANGE CASES
SKIPN CHNTB(R) ;UNOPEN DEVICE ??
↓ .VALUE ;BUT DON#T ALLOW INTERRUPTS FROM CLOSED CHAN¬
CHNI1H: .CALL SCSTAT ;GET STATUS FOR THE CHANNEL
&FALUE
ANDI D,77 ;GET ITS INDERNAL PHYSICAL DEVICE TYPE
SKIPE D
∩A
β∪→
↓λXd~(∩@@A)%'(A
⊃≥∩j4∃2w 9λA∪
8A∪)&4∀~¬∪→≤Aλb@Wλd`16~∀∪5∨-
AHYλ~∀%≠↔-
↓λY,KQ3∩~∀%⊃→λA⊂Yβ'βHQ@$HIf∩>-→↓
RLI↓α∞|rRε&pα¬αR%Iα~&d)αεJ∀
e|4PJR2~rα⊃2ε≠b~&1pH%nε2α:>QbαR"⊗p∧¬-≤T ∀dMI_∀b¬JK∩∧4→HR∧
*(∃Hh!∀∧U∃:@αb[1Q Jα Db∧EJE%≤~%∧"Hβ"B$∧∃∪∪Id⊃ ∃
Jo∃⊗'a"B(∧∧⊃3uHY(⊃β
J⊗21H⊃!"B*
4rλk∀ ⊃↓⊃.p `T⊂ b)λ'g⊂)U aeFB,@D]QdεD IFN D⊃0+D2⊂
IFN ITS,Y
HRRP∀A⊂Yπ⊃≥Q "IHh(&6⎇2∃α⊃e"RNε⊂B⊃$∀PJR2:*α⊃2R%→rRepH%nε2α&@"z4∧t⎇Dλ∩¬%K∀∧LU
ZB∧
*(∃JBλxR∧$y`u H!∀¬$dhT∧"eJJ3dLwa⊂K\α⊂5HT⊂∧g*⊃i)*h∃⊂!d T⊂"$iT j!dλ* a&⊃FE∧Pλ%))jλ!d'$MDD]P∀gP%*Tj⊂*)⊃`j⊂ TP"g"∀#c*gλ∀$W"K⊂) g⊃'fP!R g&∀CEW$U,daP∀⊗∧D]U,h"P ⊂$iP∃*,P$S(*bεB∧P%)∀j⊂!d∪$Xλ 9TAMILC ERROR OR SOMET@⊃∪9∞@ZA%∂≥∨%∀~∃ 4KZ⊗ 4D ∀4r ~E_h!Q$L4dλC αK1PPMJ)d*¬%FCββεεHK9_b∧tzD∧LuHZ$t Dλt-"λj$|@(⊃4hQ"B( *Tuλλ9∪R6A⊃.q3
8(∃q$ ⊂5Q$λ3∀Q(_⊗#"A→u1⊂i
H⊗`G{#"B)→Pr∀JT∀C"J8)α5
)h∀K∧Z⊗⊂u A".piYU∀SiI⊂1V$
∩⊃(λ9⊂4P(:⊃4C!(r∪R+πA"W!↔q3Q∧ 1SHλF,β"J8)(∩(iH⊃ &¬q L¬D⊂3Q ∀∀K fQ,s0*∧⊂3∪∧λr⊂4J4∩3U t⊂u∀ID⊂r⊂*(0q⊃**c"Th∀α03HI(∀Cεvβ[FEαh*idλ#,(⊗∀∧D]iPk"P$S*"i)∃h*⊂!R i aU"iεEαh*idλ#,(⊗∃*∧D]H g"⊂f)gP∃*εE∧R))-⊂∃*⊗⊗I
#((∀BDYc"U!d⊂!R g'"S⊂'*fP"iεEαD@D]Q'i⊂" XX⊗⊂∃$ iP∩iP b∀⊂'c⊂∀`iεE∃*,dXNεA$j ∧d!)⊗⊂**⊗⊂d'*!
**∀FB∧d))⊗⊂**⊗∃*)`i
**∀FB$c'⊂⊃_X∃b _⊗-FB∧d)&λ**⊗# !d g
**∀DNe'kP⊃bj⊂!R g'"S⊂⊃FEαd&)-∪P**ε Y∀#,∀∀D]fPebP*∩ ¬ CHANNEL NUMBER CORRECT ON TH@
AπQβπε~):∩∩w∃→A∪→≤Aλb@Wλd`4∀∪∃'@AλY)Q3∪π⊂$∩w∂ PA¬βπ,A∪≥)∃%%+!PA
≤A%≤A$~(∪!∨ ↓
1 YQ(~∀∪)+≠!
↓$Yπ⊃9∩d∩∩m≥+→_↓
+≥πQ∪↔≤@4A∪∂≥=%
~∀%≠∨- $AλHQHR~∀∪1'⊂Aλ0[' ∂1∨∞~∀%≠∨-
↓λY'(!λR
∀%)→≥≤↓λY
04∀∩A∃I'(Aπ!≥∩h~(∪≠∨-∀A$XQHR∩∩v
+≥πQ∪↔≤D↓∪&Aα↓
∪1≥U~~∃∪→≤A∪)LW'β∪0Y6~∀%≠∨- $AλXQHR∩∩w% Aβ≥dA∨ AQ⊃
AπU!%α[¬'π∪∩4∀∪β≥⊃π~Aλ0Q
1 $∩∩vA5∨ ∪
% $A¬%)&AβI
A' PA∪≤AQ⊃
~∀%≠∨-'L@Q
1@R∩∩vE
+≥
)∪∨≤λXA∪≥M∪'(AQ⊃β(AQ⊃
~∀%β≥ ~↓$XQ
a R∩∩lAπ∨%I '!∨9 ∪≥∞↓↓∪)&↓β!! ¬$A∪≤4∀∪≠∨Y'&@Q→1 R∩$vA)⊃∀Aπ⊃βIβπ) HA)3!∃λ\@AM∪≠∪→¬%→2X4∀∪∪∨HAλXQ→1 R∩$rA)⊃∀A'β≠∀A¬∪)LA' (↓∪≤A)!
A→ →(A⊃β1 ~∀@@@∪)I≥
Aλ0K)0y5)αWπQ_W)∨@W'
(-'
_|$vA≠ ¬≤A)⊃¬(A)⊃='
A¬%)&A≠U'(A¬∀A∨
8~∀αA)%'(A
⊃≥∩d4∃:∩∩m ≥λA%
≤A∪Q&W'β%_~∀∪¬≥ ∩AHXbnn4∀∪≠∨Y ∩Aλ1)%+) ∩∩w≠=≠∨∨¬dA'↔∪@Aπ⊃β%_A∨ ↓'3')∃~A∪≥Q&~∀∪
β∪≤AHY=α∩$w=α@$Q' )DA=αAPR~∀∩↓⊃%%54AλY'%∂≥β_4∃∪(H%πβ∪≤↓$Y=ε$∩w=ε$Q' )DA=λA9∪_R~)∪ H∩↓' )54A∂π∂¬∂,~∀%πβ∪≤↓$Y=λ$∩w=λ$Q' )DA=λAPR~∀∩↓⊃%%54AλY∂
∂β∂,4∀∪πβ%≤A$Yy∞∩∩wy∞∩Q=≤R∩wβU∪(~∀$A∃%'PAπ≤]≤~∃∪
∀Aλd`16~∀∪
β∪≤AHY=$∩$w=$∩!' )"↓=$A($~∀∩A!%%5~↓λY)βA/%(~(∪πβ∪8A$Y=P∩∩w≥P∩Q' Q"A=$↓→∪_R4∀∩A'∃)5~AQβ!/%P~∃*∩m ∃λA= A∪
∀Aλd`4∀∪πβ%_A$Yy,∩∩wy,∩Q'∃)"A≥\A≥∪_$~∀αAM )5~↓))3∨→ ~∀∪
β∪≤AHY=.∩$s=.∩!!%∨∞H@Q' Q"A=.↓(R~∀$A∃%'PAπ≤]\∩∩v∩@@@@@Qπ→∃β$[∨U)!+(↓(RR~(∪πβ∪8A$Y=`∩∩w≥`∩Q %I∨$@OE+∪(R$w=0AE+∪(~(∩A∃%M(Aπ≤90~∀∪
β∪≤AHY=4∩$w=4∪
%β A=+(A)<A (4∀∩A∃I'(Aπ8]4~∃
⊃≥∩dh∪'+∧↓
1 YHn`Vd4∀∪∃%M(A∪≥Q1∪(~(_~∧~)π⊃≥∩Pt∪!∨@A
1 1λ∩∩wI β_A1∪%
AU' $A%≥) %I+!(A→+≥π)%∨≤~∀%)%≡A⊂Xh``@``∩∩ld\r@t|A))dA∪≥!U(A∪≥Q %%+A(Aπ⊃¬$~∃π!≥∩iαh∪!∨ ↓
1 YH~∀∪⊃I_AλY
⊃≥)∧!$R~∀%'↔∪!∀A+≥%∃β_~∀$A∃' ↓$Yπ⊃9∩iε∩$w¬β%_B@Q≥=∪≥) I%+!(O))2$A∨$@!≥∨∪≥Q %%+A(A(R4∀∩@@A!+≤B)α~E↓1∩&<
&P%\~ε22~αV&N$
-αεt!αN.MαMα&2α&)α<_4(%α↓↓↓αU∩NQαE*&:PHI`≥∃Yj2¬-8Z"∧LjHU∃∃Z
@hP→*%≥" →e%D~APPh)_dr∧~J2eXQ(4Dt⊗W LE*+"∧"H9∧u$%
"HH↔84D 94∧⎇-DλdLDTλ∃∃∀≠⊃PPL
*%R∧EJE%≤~%∧"HQ!∃≤\~ b∧4uhT⎇αλE⊂HK:94Mα _b∧,hJ∧ <Xi`hP∀ %∃≥Dλ4Dt↔↓PPLYzd,JλEC∪βεεβα[F%$4zhYuα[↔a∪[∩g∧βkr
(∀t$yT∧4LHT∧LUHZ%∃-
APPL**5"∧9 dK$⊃⊃∪JR)Yu∀*%$βkrλYd%∧_xT4rλxU%~
*Tph!Q$≤Di↔βPM:X"∧5
¬E∪;¬6⊂hP→*%≥" →e%D~APUk8Yd"∧_ib∧MJ1PPh `h'73Z¬)zU$LhT¬$z
:D ≤4
Uα∧→jD-∃*Z¬"∧→`∧LuH~"αjT
U≤,Dλ%J∧9 dLuED∧T|)→e"bλ→d"∧ik∀M$aQ hT9 dK$7!∀l⎇hT∧2eYj$,
!⊃∪M≥H_4Z¬Z∧∧LuHZ%∃-
D∧LrλI∧(h!_4 LDλbdeYj$,
!⊃∪J∧iy∀u$Z*%-¬D
∃,-XQPPJ *%≥"
IT$ Y⊃⊂K\yz¬~
Itz∧X→eJ∧H→Tr∧→jD-∃*Z¬%~⊃Q LlzhR∧2K6Cββεεα\eYj$,
%V∩beYj$,
%9E,u(X∃∩k+QPT≤ i∪$C!~∧⎇αλeC
De⊃PPMIId*∧eF3;;vvphP∀ %∃≥Dλ4Dt⊗IhP→Yu4,TλBe,j(T
∩6⊃PPL→z2¬,j(T
⊂Q!∀E∃+$∧2d→jE∧$AQ LU*:Bβ∩
%⊂hP`h!Q#Z∧9yTl,jD∧4⎇$λα∧≤λ→d<(Q!PTLid∧T|*→∀je1Q hS772∧LjHU∃∃Z
B∧5)yR∧LhhU∀Lz$¬¬∀x8T%-(U¬~HQ!PTTx)∀u#!→T⎇4TλbdLjJ∧$`Q!∀l⎇hT∧"d~
5<#%λbHh!→T⎇4T
"d5
↓PPM99∃∧*λx45E↓⊃∪\Ld ∀r∧x5B∧5
∧∧l
∀λ$(h!∀∧l⎇hT∧5E¬Ht≤5
↓⊂KZ
85∀-R
MOVN R,D
AND R,D ;R GETS LOWEST SET BIT
ANDCM D,R ;D GEPS ALL OTHAR BITS
SKIPE D
.SUSET [.SAIFPIR,,DY ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MORE D,R
JFFO D,.+1
↓MOVNS R ;-22 < R < -11
SKIPN D$JOBTB+21(R)
.VAHUE ;NO JOBARRAY???
HRRZ R,TTSAR(D)
SKIPN J.INTF(R)
JRST INTXIT ;NO IH
) I%+!(↓
+≥πQ∪⊂≡9αiα&≡tzJ¬αLrR⊗J∃*BP4PJ6>Z≤Iα⊃⊃D!$4(M"J=α"aIAAβ↓A-q∩R):&u"→-Eph(&N\JB≡∃¬*:J⊗ `4(¬∧RNAα∩b∞":K"∧$%\:>JA
↓":>LrR⊗J∃*BQα"H4(¬α↓↓αB-~")α5BA1∩M:ε&PhP%↓↓α↓α*J≥!αbVLrP4(LRJNQ∧J:RbM 4(∀Uh$%n,r⊃α>2α&~9∧R>
&u 4(∀Ph 4(hP4(4SYemα%"NεI∧z→αR%Iα&:¬*Qα~Lb∃αε∃∩εeαLqαRQph)mmZα&*B-!α&:$*JJV¬!α∞"
∩ε∞R-⊃α&9¬⊃8$)[Y`~¬(ZE-∀dλ∀$%(Z5~∧→d∧"pQ'3[Z
(U%-)j2∧LjHU∃∃Z
B∧5Yh5$Lyd∧LR
%`hPQ*E%L_9βPh)~B MJ+"¬∩DZECeIzα]≤iE5≤5E9U$ a↔44|H@β ∩eX$M"λ9∧
⊂Q*4
_→d$J
!C;;qQ%≤
Q~E∃Td
"b-KπD≥$Ga⊂KZλIu<r
Irβ: _b∧tX8U≥≤~+⊂hU8∀PJ∧**5"¬JK∀L≠⊃Q%≤
Q_4 LT
"c vqPU≤∀Q∩¬%+$¬∩c⊗FhUJK∀L≠↔!∃∀⎇D
"bk⊃⊃∪L≤HZd-∩λ~%∀
∀λ∀≤≤Z:0hP__D$J
JBd4%h%,2
%⊂K\→jD-∃*Z¬"∧ij2∧
(T∧LR∧(%,4hZ"⊂h!→∧e∩
%BE%E⊃PPM99∃∧<T
hP→
%∃R
!BE%E⊃⊂K]9_tr∧)~B∧|d
"∧<ZJ2∧≤HX∃∀,AQ LU*:BαDE⊃PP`H*:T∃%ID¬4
)→u-~
;∃≥$YT¬%%∀ ∀u¬ZD∧≤D~$∧LuHZ%∃-
D∧D hID-∃5aPPh(9bu;!→¬∃∃)T∧"eJK∀|4a⊃∪LLYXT$L~HR¬%K→t42¬ e*HQ!∃¬-9∧∧5E¬J@hP~
U≤Bλk¬αeJAPPL
*%R¬JEE"
K→phP→Yu4*
AD
≤~%¬%"⊃Q M$Iib¬"H~2t4→A⊂Jβ9≡2α∃K→∩∩ε∀λfNfTλ↔↔⊗∨↔phP∀ T⎇4Y∀¬%"JJELLh⊃∩βZ ≤bεv}ABπ∨\.7&ONZF*ε≥m↔&N≥D¬%%∀λfNfT ↔↔⊗∨∀hP→Yu$*λJBe%J8∃∩EJE⊂hP~IDt
λJBe%J7E%Ka⊃∩β\_hbεOD}2ε
λJEHh!∀ᬬX∧r $⊃V∀¬Hs∀Sf1(∞`⊂λ f)gH"#P∀⊂f"`i gj`∀PUT T)
CN.W0: POP FXP,TT
POP FXP,T
JRST CHNI2
αIFN D20,[
CN.Z: PUSH FXP,T
PUSH FXP,TT
MOVEI T AN.Z0 ;BETURNTO SUPERIOR (MAY BE IDDT)
↓MOVA TT,INTPDL
EXCH T,IPSPC(DT)
MOREM T,CN.ZX
POP FXP,TT
POP FHP,T
JRST CHNI2 ;ALPT$G PROCEEDS
CN.X0: HALTF
ALTP: JRST 2,@CJ.ZX
U ;EJD IFN D20
IFN D10,[
CN.Z: SKIPE R ,JBDDT ;ANY DDT IN↓β∨%
|~∀%∧RJNQαBI$4PJ⊗bε"↓E0$HIfJ⊗%*J9α$yα6>tJR>I∧J→α:zα∩%ED∧≤|j@∧ \hI∀u,Z1PT JJβPL**5"∧9 dK⊂⊃↔5¬∀x8T," yb∧ JJα$8Q+PK\YhB∧Li`∧# ↓Q hT_ib∧MJ5EXh(9buS!~¬-≤∧λeEαJJ@HK8¬q$ Q11∧ sQ(λ_h∃∪d ⊃s⊃∧λr⊂3Ih3λ∪JY0Q4AQ@2∀J+H∃∃¬E,J⊃K
#"A∃Pp3 D⊂rr&)#"B$¬UP3
X#"B* tλ⊃K
∃∃↓Q@+UH→∃1( _4pr+$↔∞FhH∃αc!+↔#"A→TTu∧λr∪R&!"C"H9r,R'↓4q5 !"B4i≠⊂R5∧ ∀Q4hZ↔β"A⊗ εε ∃
A"W"!↔q3Q∧ 1SH ~∀c"AQPq∀IHnB2
*Sr(λE ,b!↔wQ`¬T∀p
a∀⊂_εEαh$h UibDDB]b$iPa&"P∃$"P$S*"i)∃h*⊂)Vij"fH#'i⊂∪'kFEαibb-∪P*g)⊃`i∧DNβC@→ ¬$A∨+PAβ→_↓')βπ- λA∪9) %%U!)&~(∪' )i~A∪≥Qβ$~∀%⊃%% 4AλI∪9)
→∞4∀∪'↔%!αA≥=#+∪($∩w⊃∨\Aπβ≤↓≥∨#+%(A¬
↓≥∨≤[i %≡}4∃∪(H$@]→∨M
∩α∩lA≠β3
A)⊃∀A+' HA'π%∃/ λAU ~*L29α⊃ ↓.⊃Iαaα"εe 4(εU∩NQα≤Z%@$KZBJ>≤*NMα$B∃α~⎇∩∞⊗⊃¬
V&P~P4*∞rrah&≤Z&B¬∧!2m55h$%n-∩JN⊗$
2∃αBza¬¬
V&PhR∞ 2hw LE*)tJ∧EES(H↔9∀lLXI∀
$T¬¬t:∀
∃,MAQ M≤9~∧*¬Yj$, AQ J∧**5"∧9ed;λQ!∃≤-K)R∧LhH∃⊂H↔94Ldβλ⊂)Iλ∩3JH4TU*
∀h∀jH0rq(D∃4β!!2∀THY(⊃β →U⊃Sλq"B4
Zr∩Hλk∀ ~p25↓Q@∧P)Rdh P⊃⊗-aeRX.FEαP⊂%)∀h⊂!d∪$Y∧DNβCAN'T PROAESS QQIT NOW
MOVEM D,IPSPC(F) ;IF CAN QUIT NOW, ARRANGE FOR SERVER
JRST CHNI2 ; TG REPU@%8A)∞A%≥) %I+!(A
⊃⊗∞\*H4(hR∞):; `&N-"j5α,rJεε⊂H%n.Lb1αN$
∞.⊗ αV:J,
1αεu"⊗JJ-αRL4PJ⊗b∞Bα⊃2Vu∩
*≤HIf⊗2≤)αNR ~-αVααε9α,rJ⊗ε`h(&R∀r∃α⊃cλ$%m¬r≥α>∩αzaαLrR⊗J∃*BP4PIα6>4*5α⊃e*:J
t8$%n$z1∞Q∧b⊗Aαλαzaα$JNB2 ~∃ᬬr≤4(LRJNQ∧~":%⊂h(4(04(hR&~9∧JRNr≤
&1∩Xh(4*L29αV≤*2⊗N~bl4*4rf&:#P&6>4)α→2LrRB∩`H%n∞|j6>9∧Bε:∩d*Iα~⎇⊃α~Vtreα&u"⊗JJ-αRL4PJ6>Z*α⊃2~E4(&≤Z&B∃∧:∞~bh(%αlzZ∃α5BA2≡≤2b@4PJBVNBα~bAd 4(&lzZ∃α∩a"I$hP&N.Mα9↓"∩H4(%∧RJNQ∧J:RbM $%n-B&QαL1α:=¬*N⊗I∧Bε:∩d*H4(LB2Ji∧!2H4PJ∞ε&*α⊃2VL2RRHHInNB,~&ε1∧Bε∞-∧2>Iα%"e6J-"VJ8hP%α*∃~Qα~uJ&9@hP&"J∃QαI2MαNB
D1$$%\:⊗Qα∧→α>→∧J:R⊗∃∩VBPhR&~9∧JRM2Xh(&∞ J∃αIe"f&∞ `$%nLrR⊗J∃*BR⊗"α~J>jα∞ε:|r&∞εbα&:B-!α↑εM!|4(Jα∞ε&rαI2RLJ∞¬DhP%↓αE∩2%α"bE∩&pH%nf-→1αε∀9αR=∧J:Qα5*9α&~↓≡&8hRt%n,r⊃α>2α&~9∧JRL4PJ∞ε&rαI2RLJb∞PHInε:⎇""⊗I∧~ε::|r&∞εbαB2ε≤(4(%∧BJ2%∧!2E∩Lp4*~uJ&9APJN.&∧:∃αVu∩⊗ε0hP%α*≥↓αI2≤B:%R_H%n6-~QαN$
∞-α-↓α&→¬*:J⊗ `4*tHIn⊗:"α>→αL29αV≤*2⊗N_h*J∞dz-IhMαVN"Rα~bAb"&↑εM %n↑Lb1αN$
∞-α r⊃αN\JAα&2α≡ 4PIα*J≥!αbVLrP$%\:&Z∃¬*N⊗I∧~2>∞Zα&:R-∩JVB h(&*∃~Qα&u"b&PhP4*tKZ⊗:⊃∧z→α&4qα&R≥bNε&`h(4(hR&~9∧JRM2Xh)mmZαJ⊗εbαR&6*αε2ε∀j∞2>≤X4(∀U∩⊗ε2≤b6∞-Ph(&6⎇2N%α⊂aQAAβ↓@$%]~"VQ∧~2>∞Zααε∞Zα>~_hP%:J,
2Qα∩`4(εlzZ⊗%¬⊃2E∩$J6∀4PJ*JN αJ∞2|YD4(hQmmm¬∩V:RLj∃αεd
J6∞dz∞,4Ph*JVt~2>∞[P4(&lzZε%¬⊃2E∩∃*:R&l(4*J≤b>-EPJ6>Z*α→2&u"B∩⊂hP&6>4)α⊃∩5B@$λM~.&B*α≡∞~E4(∀ T⎇4TλeEαHx45E↓Q M¬Z9α∧5
¬D H!~4\M d¬ (3⊂4IXq∪pi1.r1iitQ( _H⊃∩λZQ(∩*4⊃Sc!↓(∩TJ:λ∩3JK∩5α!↔h⊂3λ~S0s Xph⊃JYPq∩)YC"B)YuP dH"∩∀)
D@]j⊗h"P_ ⊂)ja∃,h"P ⊂$iP⊂f i&Pd'aeCE∧ieRh"⊂*S)"`fαD]`∪KIP IF (FOINTERRUPT T)
α JRST↓%π2|YH4(Lj>Z⊗jα⊃2Vu∩JV9m ∩JVu"& ,U
"HK8∧uλ_ph∃*∧⊂3UλZTU4
A"B2J*uλ∩)J⊗∩5↓Q@↓A ¬εE∩c'⊂*Tbf"iTV-FEβE_ 6lAπ ∩↓∪⊂~R-∩JVB α"ε:$b⊗H∀Ph*∞∩LJ2QhLRNAα⊂b~:fLrP4λM*&~∞dI12Z≤b$4λhQemm¬∩⊗@%X∧SD qH∃
K(⊃∪d
∩⊃( )pC"AQU∃∀I→U∞B)*tλ∀EHSV2)Jβ"B*Y1Q∃
% ∃U
JA"C!'nnh
;4q⊃)T⊃sr)hβP"'Udε OR BEING DEBUGGED
~∃M3'∪≥Ppλ&*≥↓αI24rf&: h(&VL2NfMbbRNf≤ 4(Q'3KZ X∃∩∧*(T XQ!PTl~)∀`*∞B3)zQ2(
% 4∩)X4C"A_3Q⊂h→(⊂C →α`ieCE .SUSET[(
'≠¬'⊗@1dJ6εN]h4(∃j5-≤Z@¬JU9X∃∀
EJ#;¬QQ LlzhTJ¬%F∩ZtK$α-∧→X∃⊂h!~4\M `¬4l~!PPJ *%≥" →e$e6⊃⊂K\→`λλ`ibP
)j j∃iP&`T∀P#bU)P&'Uibb∃hεE∧R)h⊂) #',dS*εE∧Udc&`T⊗⊗+&PiεEεB,DD]QdεD OF @∪
8A+' 1 '&~):∩g 9λA∪
8A∪)&4∀_~∧~(rvvAM)βπ⊗↓+ Aα↓+' $↓∪∃) I%+!(↓+⊃βπ A≠+'PA¬
A⊃ →β3∃λ\~∀lvvAβI∂+≠ 9(A∪&↓∪⊂→α αεMα4zIαVLrQmαM!α&M¬~εZ⊗"α&9α$B∃αεu"εIα
*⊗F∃ph)mmZαεNN,j⊗Mα5∩⊗∃α-~∃α≡2αε∞∞,jV2ε$zIαIph)mmZαB%αF
YESIN1:↓POP P,UISTAK ;@)!∪&A∪LAαA⊃=%%∪¬1
Aπ%=β⊗~∀m+∪')¬⊗t@@h*V&≥"-EhLj>J∃¬⊃2&:$22≤$KZ&→α<)αεJ*αε
>-!αR=¬
V&Q∧
:f↑
I04(L
>*1¬⊃2αVM~Rε,HIeαRD*1α~⎇∩≡⊗Q¬""¬α<B>2∃¬""&:8h(&ε⎇→αI2LrRεHhP&∞εLb∃αIdb& 5H~ hP∀ %∃≥D
Dl$→Y⊂HK8Itj∧X→eJ∧H→Tr∧→jD-∃*Z¬%_Q!∀l⎇hT¬∩e6Fβββε¬4dLjH∃∩k∃EDLUH~"\d→jD
∩T+PhUY~5$['!∃∧⎇∧
"c
%⊂hP~IDt
!C≠;vvs(h!∀∧U∃:D¬,M:I3⊂h!→T⎇59T∧"d→jD
∩6⊃PPM8ZD|@(∩3JHS⊃c!!2TTjD⊂∃2*:⊂2c!!"U∪(H32.A~rr4 d⊃pqK
α".jIqh∪(→V(⊃λ→3H∩)j⊃4TJZ∃∀c!!(∩TJ:λ∃∪(H3,C! 4Tλ ¬ ⊗t¬HS∀ λk∀ ∀j !"B)YuQ( ¬⊃ph+↓"U⊃*)23C!*∪1⊂)VNC"G⊃3⊃4J$⊗tr+λR5λ J∪sh X3V(λHαc"i∀"b⊂$S*"i)∃h*)PW.@
IFN ITS,[
.VALUE KASCIZ \:≠TOO EANY DEFERRED INTERRUPTS≠↔CONTIN⊗
\]
.LOSE
] ;END OF IFN ITS
10$ OUTSTRYASCIZ \TOM @≠β92A → %% ⊂A∪≥)∃%%+!Q'9:~(b`H∪∃1∪(@DX~∀b@H∪∃%M(@\ZD~∀
∃%
≤AλH`Y6~(∪⊃%%=∩@bYmβ'π∪hA8~∀⎇)←↑A5C]rA⊃KMMKIKHAS9iKeeUaif~)9:
∀%⊃β→)_~∃*∩$w ≥λ↓∪
≤A⊂d`~∀4∀w#≠¬%⊗@Z4A)⊃∪LA∪&A! %
AM≡A¬β-)%βπ∀A/β→0A
∪≥⊂A∪(A¬&A→βM(A'+ $@QβI∂∞BB$~∃#≠¬%⊗t∪5∨- ∩↓αY#~4∀∪!∨A∀A X4∀~∀_~∧~(vvvAA+%
AAβ∂
AQ%β A!β≥ →∃$~∀vlp
α∞|j⊗MαD*J¬α<JR!αdzN&::αB
αLqα⊃_hP%:N,)α6⊗l*JH4Ph*BV∃α≡%hhR&~9∧!EA)c 6NεLay2lhP&N.Mα∃α. B@4PIαN>≤ α⊃2MαNB
D1$%↓α↓n6ε\)αB
¬α>&:"αR=α|2~⊗:$J2≥αLrNBJ,~R&>ph(%↓¬~.&Bλh(%↓ααε:∩Jα⊃15λh*t%\*:↓α|1α&~rα⊃EASaE6N J1x4TJ~9α#⊃A2lhP&N.Mα9αR,r⊗b@HI↓↓↓\J→αR,r⊗a⊃¬α
α⊗L:"QαtzQα
*αJ&≡E 4(%∧RJNQ¬αVJB<λ4(&¬*N!α5BA1DhP&BV≤Aα~bαaH4(Lj>Z⊗J↓E1:4BN2_hP&≡R∃α\$$J↓↓↓n<*QαR∀
AαN$
RVM∧J:R=β 1α↑∀JR∃α$
R¬αLrR=↓⊂h(&Rdr9↓Ec↓AAA $%↓α↓n
&"↓EQ↓jαJ⊗ε"αJ⊗F,*NP4PIαR2tq↓E1β↓AAA H%↓↓βZ
&Qβ U↓5¬:J&R*αJ⊗F,*NP4PI↓αN\JB∧$HI↓↓↓]∩⊗ε⊃¬∩E1α⎇⊃α:=¬:J&R*αJE↓jiαB
∧JMα>Xh(%↓ααN>M∧!2&B≥α
"→HI↓↓↓\z:2e¬:J&R*αJE1¬α>&:"αR=α ~RVεbα&:N%∩V∞RLz84(LBJJj~α⊂$$J↓↓↓n≤b⊗εI∧:εJ
:∃α~∀z5α2,2Qα" b_4(Mα>Aα5BA1HHI↓↓↓]∩⊗NR⎇∩∃αε~:L4(Mα>Aα5BA1DhRBVJ∧:¬h4Uh%n⊗t!α&~rα⊃I@hP&∞εLqα⊃2≥"FBV⊂h(%αU∩NQα¬α≡%ThRBB≡K*¬h4TJ~9α∧
≡&::bl4*l
∞J>dz>AαuαVJR∩bjjAbQ0$%α↓↓njU↓α6ε≥∩>Mα$*~&:*α↑"ε"αB2ε≤*Mα"
2∃α" r∩2⊗∃_4*tHIn⊗:"α&~9¬αε≡&t84(&U*6B≡*α⊃2B-∩⊗JHhRBB≡K→h4(LBJJ5∧!2&B≥α
"→Hh(&*∃~Qα&u"b&PhP4*B∧:%UhLBJJj~α∧$$J↓↓↓n4zJ≡⊗"α2⊗~"α"ε20h(&∞ J9α¬eα↑&>LrP$%α↓↓n
Lr∩&::α&:R-∩JVB"α&:"L∩&RMRα:>Jl
1αB-∩RJεh(%αU∩NQα¬α≡%Vλh)↓↓α↓↓↓↓∧j>Z⊗jα¬2N%
2VhHI↓↓↓]∩⊗&⊗l∩⊗Iα<B&∞↓¬2ε2V*α∞⊗2bα↑∃α%∩&⊗⊃¬"=α≡∀z2,4PJ6>Z*α⊃2n$JJBε$)12:Lbt4(Lj>Z⊗jα⊃1"≥↓$4(M~.&B*α≡∞~E4(¬αrZε2,(4(& zMα&¬~B
"2H$%n$z9=D
$-∀V(
I⊃(∪ zr3Qd 3Tu
*0u∩)yH#"A~∃4r $⊃R∀¬D∩5p)~α.sλZλ∀tλIλ⊃q*D⊂p5(y∃λ∃*↓ B(
9r4⊂$
∀u
→∃2B!↔q4TIZH∩⊂)h∪⊃4D
p3U
4∪∪ph~⊂3sD 3H∃↓QB(λ *Tu
4Q4J!".r)j∃p2*D∪06$
rr4↓QT∀⊃i⊗LB2
*VR(λE∪R3
85∀"!↔u∀R(Xλ∃∪d
∃5λ∀∃P3
X(∀∀Iz⊃4U ∀⊃s@ I3β"A→TTu∧
∀⊃r&1"C"@↓A Tu(*∃∪α*Zq4@ →U⊃4J*4∃
)u1∩)h4c"AQNnnd
4q4D 3Q⊃**U4∃∧
⊗4⊃*4⊃StD Q1r)Q"Nng1"NngP#'i∪P'c⊂⊂i#jfQg*⊂*∪P*dg∃⊂∀ f∀gP)j∪i"b⊂∩g⊂"$∩iP#'T&FE≥N]P$gλ$g" T⊗⊂'g∪,P+dU$⊂$ S+"iP∀k`h(⊃b≥P+R,V⊂$H"#gβU⊂%g'UT]εE∞]]FE∞]]DZ ≤VYW D`i#Udbg*λ#'i⊂∩g*"i∀*h*⊃*g!j∩gcεE∞]]DY ≤Ddcλ_V⊂)T"adc∩biP H**,P∩e(*jλ!d i⊂aj"iλ$g*"T)*h* ∧E≥]NDD`i⊃jfbg∃⊂$iP∃*,P$S(*j⊂⊃$f"P⊂i) lKεE≥]NDDY↔∞⊗Y↔~αfjijλ!"P-⊃i'WεB≥]]DBY↔→VLW_DaR i aU"i⊂+R$ad⊂⊂`jibQ⊂$g*⊃i)*h∃⊗⊂ iCE≥U]BDDi"Pb⊂!,H↔$j,RaW⊂⊂∃$$iP∪`lP!⊃P P_L↔⊗a$UεE≥]ND@DaR i aU"i⊗⊂⊂g"⊂)SP&`lH$ k"H*'P!⊃P#'f⊃ bεE∞]]DDBa"c'T"P)bS"ab$S#P*$⊃P g*⊃i)*h∃⊂#*g⊂j$gg εE≥]ND@Dj∩$iP$TP( iTbb⊂ TP*$"H)bagS ⊂ i⊃jfbg∃↔εE≥N]DY↔∞∧dc⊂ V⊂)h⊃a`c$QiP gλ$g*"T)*h*λ)"f U"b⊂*∪P P#∩f"FE∞]]DDPi) lH'i⊂)Rfdf T⊂'a%⊃aj⊗⊂⊃W#W∃$"P∃
&gi"J∃εE≥N]DDdS*"i)∃h*⊂#∪i⊂**⊗P'jj∀*j↔εB≥]]DB`i#jSbg*⊂∩iP"$⊃P#$f⊃P i)⊂lWεE∞]]DDL↔≠VXK_P$iH*$"P∩dεDEX OF TH@
A∪9) %%U!(A
U≥π)∪=≤∩∀vlr∩∪/%)⊃∪≤↓)⊃
A¬%%β20A/⊃ I
A)⊃∀A→∨.↓↓∪(AM! π∪→∪ &~(vvv∩%→
(↓∨$A%%∂⊃(A!β→ A¬&A+'Uβ_\~(vvv∩H\n∪∪_@bXAM! π∪→∪ &A∧A≠βπ!∪≥
A∃%%∨$8~∀vvl∩∪)⊃∀Aβ%∂U≠ ≥(↓∪&A)!
A ∨
β)∪∨8A∨ AQ⊃
A→='&\~(vvv∩%¬∪)&b\rZD\bA'A πβ
dA)⊃
↓≥β)+I
A∨ ↓)⊃
A∃%%∨$8~∀∪+%≠!β$tzt`∩m∨ $∩w!βI∪)2A∃%%∨$4∀∪+∪5∪→∞zttb∩w∃-β_∩$w∪→→∃∂β_A=! %βQ∪∨ ~(∪+∪≠]%≡zzhd∩w ∃!∨'∪P∩w/%%)
A∪9)≡A%∃βλ[∨9→2A≠∃≠↔%24∀∪+∪5≠!,ztpf∩w∃1β≠∪9
∩g≠∃≠∨%2↓!%∨)∃π(A-%∨→β)%≠≤~∀lvv∪∪_@d\r4d\nA¬%
A5∃%≡XAQ⊃ ≤t4∀vvv$d\dZH\b∪)e!
A∨_A∪≥)∃%%+!P~∀vvl∩b\r4b\b∪M! π∪→∪εA∪9) %%U!(~∀lrv∪πU%% ≥PA)3!∃&Aβ≥⊂A'!
∪
∪ε↓∪∃) I%+!)LAβ%
h~∀vvl∩`∪%¬≥ ∨~↓β'3≥
⊃%∨≥=+&@Q⊃ →β3∃λA¬2Q≥∨∪9) %%U!(A($R~∀vlv∩∩`%β→β%5π→∨π,~∀∪+%
π→∩tztb∩mπ→∩[5 ''β≥
∩∩wU' → M&~∀∪U∪
≠βHzztd$w∪β$5¬% β,∩∩w M → 'L~∀∪+%
))$tztf∩m))2[I !+∀p$%n-~⊗2⊗≥_4(&,J~Nf≠iuiPKZNfMl"⊗εR@H%nV≤*2⊗N_h(&VL2N6%kiiT%]~ε&1ljε&1lJ:P$KZVN⊗d*NL4TJ~∃α-~⊗2⊗≥→1α:,J:QAiiiD∧HI2N⊗*α≡∞A5 X4*L29αV≤*2⊗N~bl4*≤ ∃&u*&:QβiuiTHH%:N,)α≡∞β2EXQ*4
→jTLuFπSkSa⊃⊂K\→ID⎇h⊃Sj$∀p2)E302)D∩3UλZTU4
A"W"'83Qλ xH∩1Id∃4q)H4tc!!"Nng⊃,"4H→Q∪s$
v3Pi
SsSjZc"Ng↔b",↓_55∪iIp1β!'nnb!⊗"14J*q5λλiC"Ng↔b",A∃TTq*E5∀P*↓ Nng⊃",b(xk1⊂(Y3sC!'nnb!⊗α1peYuQ4Hi∪uc!'nnb!⊗"4⊃ E3uQ*(S∪uaQSU2)j //'&B""%@)bbP⊃ah≠(M∧E≥]NDY∧bT$g*⊂
)lg!R)'g'UiTFE∞]]DDL∧jg"⊃⊗c'!U'αE≥N]DDXBjg!'⊃⊗k!!∪εE≥]Nβ 2 WRNG-TYPE-ARG
9;; 3 UNSEEN-GO)TAG
3+; 4 WRNG-NO)ARGS
;;9 5 GC-LOSSAGE
3+; 6 FAIL-ACT
;9; 7 IO-LMSSAGE
NUINT2==:10 .SEE GCP6Q6
α;;9 WE NORMALLY DON'T PUSHJ HERE AT ALL FROH
A↓$A→ -∃_B~∀lv@Q !∪≥⊗A¬¬∨+(↓⊃∨.AQ≡A'∪5!→β
dA)⊃
↓π↔
↓⊃⊗J*q$4(hRV&:#P&BV≤B)αAe*&:R¬(4(ε≤Z&B9∧r>FVM 4(¬¬~.&B*α&*"L∩&P4PI↓α*∃~QαVLrQH4PJN.&∧:∃α→jD4dqQ J∧**5"¬Y→e#_Q!∃¬-9 "¬αJY∀u#↓Q hRj8T*¬Y→e%¬Q↔5∧ z D*∧9yT*∧λZ$*¬It¬,tIt¬,LjJ¬(h!⊃∪LTzHSB¬IλR¬¬X9α=~ xb¬,→jE¬* ZU≥"
;∀t~
y∃$B
I∧*¬ zα=~ λU∀(Q*TLuH[βPh)_drβHF∪α\F&βre1Q M∧z∧∧5E¬ItLL~90hP~ uα∧k
αdLX~4Xh+Q⊂K\YhB∧Lidβdβ⊗¬4#∪πaPPM99∃∧b¬λeEα⊃Q J∧**5"¬Y→e%C⊃Q M∧→yd <→→`hT~DBJj:U≤-D 2e≤Hf∩be&v¬hh)~B"∃j5-≤Z@¬Z@Tq⊃F% ∀Mf !"C!*23U ε,B4jXH⊃V
¬∀Ml¬6".qhZλ⊂R(D∪qH
(13P()⊃(∩)j⊃4TJZ∃∀hλi⊂1c!!4∪t∧λV∀
!"+ThX(∃2)j∀⊃#!!2TTjD⊂r⊃(→r""'~⊃∪ )zQ0QIIuh∪(≠(∩⊂*h(⊂Q(YH∀uλ_rq1↓Q@""!∃Tq1$
⊃∪∪ja"C"AQU23JFNB2J:H∃2*:⊂2b'8⊃3⊂+∀⊂(∃*84H∩)j⊃4TJZ∃ λ
93Pq$ 3R∩( 5λ∀jy5⊂r∧ 4h∪ia"B2J*uλ∃)→U⊃6↓QA"U)→U nA→∀TVDλ ∩3JHS⊃b!↔pr⊃(→h∩3JH4TU*
λ⊃Sλ_h∃∪d
q1(
I⊂5λ ~h∀p+~hλT*Y5λC!!T SOME INCONGRUOUS USER PI
JRST CKI2
HHCTB: .VALUE
; LERR EMS11 ;HOW THE HELD CAN THIS BE?
UINTPU: ;PUSH PI STATE, THEN DISABLE
PUSH FXP,R ;SAVE R FOR UISTAK, ETC*
PUSH FXP,T
IFE ITS,[
PUSH FXP,IMASK ;SAVE APRENB MASKS
PUSH FXP,OIMASK
MOVN T,INTALL ;GET PI STATE FROI INTERNAL WORD
EXCH T,-2(FXP)
SKIPGE -2(FXP)
PIPAUSE
] ;END IFE ITS
IFN ITS,[
.SUSET [.RPICLR,,T]
EXCH T,(FXP)
SKIPGE (FXP)
PIPAUSE
] ;END OF IFN ITS
POPJ P,
α
9;; SARE THA GORLD FOR AUSER IJTERRUPT, INVOKE IT, AND RECTORE.
;;;
;;; SAVED QUANTITIES INCLUDE ALD AACUMULATORS, THE PDL PGINTERS
;;; (BOR FREDURN), AND THA @'U! $[]%∪)β →
AπQ+
@!) ≠!=%β%∪∃&Aβ≤4∀vvv↓→∨.A
∨%
AU' λA 2A∪≥Q %%+A)β¬→∀A
+≥
)∪∨≥LR\
∀lvvA≠¬≥2A∂1≠¬β_↓'/∪)
⊃β&A¬%
A¬=+≥λA¬≥λA%∃' (\4∀vvv↓
∨$A¬'3≥π!%∨≥∨U&A+π∃$A∪≥Q %%+A)&XAQ⊃α@Q9∨∪≥)∃%%+!PA(RAM)β)
4∀vvv↓≠β2A
A ≥Q % λlA)⊃
↓!% -%∨+&A9∨∪≥)∃%%+!PA')βQ
A∪&↓'β- ⊂\~∀vlvA≠ M(A≥∨PAπ∨≠∀A⊃ %∀A/∪)!∨+(A→∪%'(↓+'∪≥≤A)⊃
I∪/β%(~∀vlrA%∨U)∪≥
↓)≡A ∃π∪
↓/⊃ )! $A∨HA≥∨(↓/
AβI
A∪≤↓∂ε\~(vvvA¬→'≡A5+'(A
⊃ π⊗↓)⊃
A9∨∪≥)∃%%+!PA'/∪Qπ⊂A¬∃
∨%
↓π∨≠∪9∞A⊃ I
~∀vlvA∪ ↓)⊃β(↓∪&A%∃→ -β9(A)≡↓)⊃
AAβ%)∪
+→β$↓+' $↓∪∃) I%+!(8~∀vvlA∪≥)∃%%+!Q&A≠+M(A¬
↓)+%≥∃λA∨
_A/∪) A!∪∨_A¬
=%
Aπ=≠∪≥∞↓⊃ %
8~∀vvlA)⊃
↓/∨%λ↓ 'πI∪¬∪≥≤A)⊃
↓+' $↓∪∃) I%+!(↓≠+'(↓¬∃αLqα⊃8hP4(Q+∀-≤→jC@M99∃∧r iu
,~APPJλ94M∧T ∀tD_)∃ h!∀α∧U*:B¬LZ9∀sλQ*TLUFπ hT~D@Ju:Z4-" 5e≤$f∃Be%K_D3
Q↔4m-:@∧ dIzr¬∧ID∧m∀X(dd⎇tλ∀t" XTl]+⊃PDMDA∩e≥X8U"¬5j4$3%EE%%_Hc∃h↔4∧-∃)z%~¬It∧<zλI¬∀⎇Xyαb∧*ZB∧tt u$DX*0hT~D@M∧→ybh)_db∧F⊗α\#&¬EXh!~4-%)P∧LUH→D`H↔:Tt∧t
DD( qλ→⊂∧g* FE∧h∃id%⊂∀⊗"$iRe*∧DNb$i`P&"P T()'h∀$`j"H$g""T)*h*∀FE.DB]bg"λ$c'⊃_X∃b _εE∧R))-)H∀(∀DB]kdf∪⊂$!)∪βS IF ASYNCHRONOQS
PUSHJ P,SAVP5 ;SAVE NEMERIC ACS
PUSH BX@,UNREAL
α PUSH FXP,SPSV
BG$ PUSH FXP,BNV1
MOVSI R,-LSWS
PUSHFXP,SWS(R
∪β=↓∃≤AHX\Zb4∀∪! M⊃∀A
a Y'βXj∩
∀%≠↔- 4A' YM!',∩$s')βI(A¬∪9 ∪≥∞↓(
εJL
2⊗_h(&6⎇2⊗%α
⊃E"i→@hP→Yu$,∀λ∩dd~8∃⊂H!~¬-≤ $¬αd)→d# Q!∀E∃+$∧
∪(∃E",_*d`K8xU"¬IλRα\→jD-∀h→BlLhHU∃∃Z
Bl∀zYd"mh~$L )HU_h!→Tm4i∀∧~CT∩"`H↔8D|RzD¬%∃∀
Dj∧)→d"¬Iyr∧l→k∩¬$ →d=_Q*TLUFλ∪PM99u%"λ~#∀
IJ0hPα(∩J*uλ∃)→U ⊂AQ@∧d&∀-⊂ V
i→ JDD]a∩e"⊂ S&⊂*iQi⊗ih⊃a`c$Qb⊂+ T)P*'H∀⊂PεB∧h*iR%⊂(⊗⊂$g"εB∧d))⊗⊂ i→⊂V∀ i TFEα`ge&λ!V*dS*_ FB*dg* !≥∧e∀h⊂*⊗∀h"alβE∧h*Td%⊂#⊗(⊗))U~FE∧Tbj-&H( Z∧BD]` M⊂&jiU⊂!"P∩g⊂"$⊃P⊃)kTQ⊂ i⊃`BE$Q'⊂*iQf"iiK∧ibj⊗&P*,SikFEαibj-∪P$g$∩a$jεB∧ibj⊗&P"gQ)*'∧BD]b'H''j⊂∀bj-&H!`j)∃'⊂P#R)P+`S*)FEαibj-∪P!#(∀"(∧DB]P*'H*$)'UP'jjλ'c⊂*Tbi⊂$S*"i)∃h*)FB∧ibj∪d¬ ERRSW
MOVE T,[-LINTPDL,,INTPDL] ;MUSTN'T CALL UINT0 FROM
CAME T,INDPDL 8εA/∪Q⊃∪≤A∧A!∩AM %- H~∀∩@9→∨'
4∃% ↓∃β(@f0∪!+' A
1 1$n`∩m%β≥ =~A'→=)&A
=$A≥+5 %∪ε↓β%∂&l~∀v∩$∩∩fA¬→'≡@PXrA∨_A)∨ ↓∨⊂~∃βiyαJ-"VJ9¬2ε"V*α6εR$*JL4U*&bBαZ4CkW&b[
8)∀<UYU4e≥z53_H↔8∀l]YjB∧|d
5%,hd¬¬-9λT"∧y`λλk∀β"JY4utgW.K' Jutjf7Jl"!⊃.p d⊃i"P)UiP)j⊂i*)P∃d"g∀`k"bλ'g⊂#⊗(εE*Ri`k*∂↑]*dTkiV[Ka$cg∃fDDDNid"i⊃P aaUfjf U'i⊂*λ#bb)H)`k"Q∧E∧h∃id⊂( -R*dQ) fbWDYc)⊂dbP&Pi%biλ g"⊂∀ ")P∀`k"bβE PUSH P,FXP 8εA'≡↓)⊃β(↓)⊃%∨\Aβ≥λ↓
% %*J9α<J0$(LBJ25∧22A⊃E↓$$∃j4,*λY∀∃∀1Q M¬Z9∧R∧i
αe≤~fPHK8∧p*h(⊂4Hz313JD⊂0tdλ3QλεFλ∪sAQB4∃*9λ∀ εFα".d
Q1tλIλ⊃Sj$⊃ph
Su⊃(~∩3sAQ@4∃*9λ∀
λ,c"JY1TS'W+,k)h0tb!⊃.s∪h85∩3id∪qHλjP31$ sH∀HXt⊃∪↓QU24h~P//*Y1TS%6B""'9∪pp*I3sH xH⊂0dλ(∪sD
Q1tλIβ"B)YuQ2$λ+∃2(jS*∀¬⊃"B3)zQ3(λ∃∃24JIC"B)YuPr$λ4LP%E⊂p3 HH +¬⊃"B2 JVH⊂%Hα".hx5λ⊃I~Tuλλ~Qh⊃IzH∩3JH4TU*
λ⊃SAQB5∀K)H⊃ εF ε↓".qλXqq⊃$ 3U⊃**U4∃∧
⊗4⊃!QB(∩J*uλ∃)→U l↓Q@2∀J+S(⊃¬E⊃V∀¬⊃".u
K(∩3J
5λ∩)j⊃4TJZ∃λ⊂iλ4C"A→3uQ)∀∀K
λE!"B)YuQ(
J ∃∃
84J⊂%⊃"B2J:λ⊃
J⊗20i↓".qHZ⊂rλ →U⊃4J*4∃λiC"B)YuPr$λ4LP%E⊂p3 HH C¬⊃"B2
*R(⊂*&P+
%!"B)YuQ2$λK
⊃K
""'ibagS ⊂ i⊃P$iP⊂d i Ph"iεB∧e))U⊂*dg∃→XFEβ∧@
UIND30: TRZN D,200 00
∀∩↓∃%'(↓+∪≥λLd~∀∪5∨% ∩↓)(XQ⊂R∩αwIβ∃ ∨4A
∪→∀A∪≥ ∃%%%+A(~∀∪I∨ ⊃α%!15DhP&"J⊂αεIJ
bαRR≤
I"¬HIf~⊗$~!α&u"⊗JJ-αQα~,r∞R&|p4(&≤Z&B1¬"P4(Jα"2I∧
IJ¬dαRRN
⊃"¬$hRV&:#→Eh→
%∀⎇4
TL5)US
E¬⊃∪L
;→d≤E)yd⎇-4 ∀u$Z*%-¬AQ LU*:B¬,→jC#Q!PU,→jC≠∪!~E∃TdλBc εεββQ!∩∧U*:B¬,→jC≠_Q!∀E∃+)R∧
EV∩D∃
¬⊂hP→Yu$,∀λ∩e xHEαDE⊃∪\L_9∧LTTλU∃∀z!PPLYzd,Jλ%BD5
¬⊂hP→Yu4 ∀λ2bk∃λeEα⊃Q LlzhTJ∧~"∩bk%λeEα⊃Q Llzj4J∧~"$
bλ8∀dddεBbHβ"B)
TH⊂*&P+∃IX4TC!!2TTjD∃23JF β"AQU23JFlh
∧S"!⊂*∃⊗-XXL→__⊗ ".D]P$j)P ↔→⊗Y α1 ARE CLASS
ANDI D,777 ;!.9-1.⊃ ARE SUBTYPE~∀%1π(AU∪≥(r@Q)(R$∩w
Qπ⊂A∪9) %%U!(A
U≥π)∪=≤∩∀∪aπ A+%≥(rb!)(R∩$s'!
∪β_A!βπ↔ε4∃+∪≥Ph`t∪M↔∪!∂∀A+∪
I~ZbQ@R~∀∩↓' )∨4A+≥%∃β_~∀%!∪∨≥¬∂β∪≤$∩vTT(TTA¬∀[ ≥β →
A∪9) %%U!)&@(TTTT4∃∪(H$]'+π∃(A6]M bX1$na:4∃∪(H$Y'+π∃(A6]M dX1$na:4∀∪)%9≤Aβ$IαXZb$∩w∂≥12A!¬=β '&↓∪∃) I%+!(↓∪ A∪9(A
+9π)∪∨8A≥∨≤5→∪_~(∩A) iαAαY∧∩∩w
=%π
A∧A% %*J:⊗"αRε2,)α>→∧r&1αL1α&Q∧jεRR-∩L4(J↓αb∞"αεIJλH%nε¬α2eαLrR⊗J∃*BQα5*:∞RLz0$(LBJJi¬!2V&5∩5-EE↓$4(L~ε&∃¬!1"~E↓$4(JαBVNDQαA2,J:QQ(h(&"e∩iαQe*&~JhYE"AHh(&∞ J∃αQbB~2AHh(%α¬*N" ¬↓2V&u!QX∀PJB&B
*N∀4PJN.&∧:∃↓λk¬αH⊃↔4L2λ(U%-)d¬$ JXR∧l~JD-∃1Q J∧Yzd,Jλ⊃E,M8~d
E¬⊃∪J¬8~d*∧~D∧4⎇$
$-¬X∧SAQB4∃*9⊂H∀¬J3PR)@ ∧D]T"ib'T P&$T`i⊗⊂⊃h!WεB*dg* ,≥∧d∀&$P) *dikTT#$(
FE∧d∀)$P) )kiFB∧a&*λ)⊗)kTUf)kTVXD]T"ib'T P!jT"i⊗kT$j a∪"P ∪TUFF
SUBFXP,[-UISWS+1,,-UISWS+1]
BG$ POP FXP,BNT1~∀%!∨ A@Y!αf4∀∪!∨@A Xh@~∀∪!U'⊃∧A→1 Y%M(k~b4∀∪!∨@A XZHQ B∩m↔≥∨π,A∨
↓!∩2~αε:⊃¬*&~J j∃1α≤
R&:8h &N,⊃αA2∪9A-DKYαNε4*⊃α∞|rR⊗:%→α>→∧ α~>⊂αB>B Qα
⊗dz\4(Mα>Aα5BA2N¬~X%n⊗+OS?⊗)βOS∂#∃β?2αNB⊗≤∩&*∪Ns≤4(Mα>Aα5BA2⊂KZ> $D
5$
HT∧l2λYe∀,→APPM99∃∧b¬V∩Eα⊃↔4L2 →e$-**U¬"λx∃≤Rz@∧
≥→h4E∀yiu-~AQ J∧**5"¬Y→e#C↓↔2∧mZ:Dr≥Dλ∃%$YZ¬"¬It¬∀-8Iu∀*λ¬3J(03β!!16⊂i∧⊃ ∃)jQ03↓↔uq3 Eλ∃q$
p3U∧
∪h∀HZu∪tHT⊂5 D
p4h ~α⊂'gβEe*Sh"P" *dg*∞≤∧]P∩*ij⊂∪'k←P∩c⊂''U⊗⊂)"U*i'↔βEieRh"P K*g)"Pf∧]b∩b⊂+bH%*ijλ**a'λ$j⊂'Q!⊂!,H)"aj∪i$g#H$j∨FB∧P%)∀j⊂*dS*_%∧NβNO, IP'S STILL ON - RE@)U%≤\~)+∪≥λA≤tβ⊃I%4A(0ZbQ $∩wβ&↓)⊃
A
⊃⊗∞])αJ>-"& 4T ∃%≤YHb∧≤→IDLTt T+xQ!∀821q$
⊃3Iy3Uα'∀⊃∪sDzλ⊃p)jλ∃∪dλq5λ
:∃0rd 3H∩)HR3R*H3⊗#!!(⊂p)_q(∃¬ISr3JH4TU*
α.`
(0p
i∀dk"P⊂`f&)CE PUSHJ P$CHECCA ;HACKISH ENTRY IJTO CHECKU
JRST UINT88
~∃U∪≥(aht∪'↔%!→
AU≥% β0~∀αA)+≠!→∀AI+%≥(a≤ENABLE INTERRUPTS
JRST POPAJ
EUINT0:: .SEE PDLOV ;END OF UINT0
UINT45: SKIPA B,[QFIXNUM]
UINT46: MOVEI B,QFLONUM
EXCH A,B
PUSHJ P,UINT49
EXCH A,B
POPJ P,
UINT49: FAC [PDL OUT OF PHASE IN USER INTERRUPT (SYSTEM ERROR)!U
UINT90: HRR AR2A,VALARMCLOCK(D) ;ALARMCLOCK SERIEC
HRR AR2A,VAUTFN(D) ;BANDOM SYNCHRONOUS
HRR AR2A,VUDF(D) ;ERIJT SERIES
↓.VALUE ;??
UINT91:↓HRROS UIFRM-1(P) ;ALARMCLOCK (ASYNCHRMNOUS)
JFCL ;RANDOM SYNCHRONOUS
SETOM (FXP) ;ERINT (VALUE MATTERS)
.VALUE ;??
αCKI0: PUSH FXP,D
HRRZ D,INTFLG
↓CAIN D,-1
JRST CKI1 ;DELAYED USER INTERRUPT
PIPAUSE
CKI2: SETZM UNREAR
CKI2A: SETZM UNRC.G ;CHECKU JOINS IN AT THIS POINT
SETZM INTFLG ; RESET TTY NO RESET
TRNA D,4 ;↑X -6 -2
JRST CKI3 ;↑G -7 -3
IFN ITS+D20,[
PUSH FXP,D
MOVEI F,LCHNTB-1 ;RESET ALL TTY FILES
CKI2F: SKIPN AR1,CHNTB(F)
JRST CKI2F1
MOVE TT,TTSAR(AR1)
TLNN TT,TTS.CL ;DON'T RESET THE FILE IF IT IS CLOSED
TLNN TT,TTS.TY
JRST CKI2F1
MOVEI T,CLRI3
TLNE TT,TTS.IO
MOVEI T,CLRO3
PUSHJ FXP,(T)
CKI2F1: SOJG F,CKI2F
POP FXP,D
] ;END OF IFN ITS+D20
10$ CLRBFO
10$ CLRBFI
CKI3:
CKI3B: TRNN D,2
SKIPE PSYMF
RQITR: LERR [SIXBIT \QUIT!\] ;SO ERROR OUT FOR ↑X
IFN USELESS*ITS,[
MOVE T,IMASK
TRNN T,%PIMAR
JRST CKI4A
.SUSET [.RMARA,,SAVMAR]
.SUSET [.SMARA,,R70] ;AVOID TRIPPING THE MAR DURING THE ERRPOP
CKI4A:
] ;END OF IFN USELESS*ITS
PIONAGAIN
PUSHJ FXP,ERRPOP
PIPAUSE
IFN USELESS*ITS,[
TRNE T,%PIMAR ;ERRPOP PRESERVES T
.SUSET [.SMARA,,SAVMAR]
] ;END OF IFN USELESS*ITS
MOVE A,VERRLIST
MOVEM A,VIQUOTIENT
JSP A,ERINI0
MOVE P,C2 ;DRASTIC ACTION FOR ↑G
SETZM TTYOFF
STRT 17,@RQITR
JRST LSPRT1 ;WILL PION WITHIN ERINIT
CKI1: SKIPE INHIBIT ;RETURN TO SERVICE THE DELAYED INTERRUPT
JRST POPXDJ ;BUT NO SERVICE WHEN INHIBIT = -1
PUSHJ P,UINTPU
SETZM INTFLG
PUSH P,A
PUSH P,A
HLLOS INHIBIT
SKIPG A,INTAR
LERR EMS13 ;LOST USER INTERRUPT
CKI1A: MOVS D,INTAR(A) ;FOR GC PROTECTION
MOVSM D,(P)
SOSG INTAR ;CYCLE THROUGH THE DELAYED INTERRUPTS
SETZM INTFLG ;TO PREVENT TIMING SCREWS, CLEAR INTFLG IF
; NO MORE INTERRUPTS PENDING
PUSHJ P,UINT0
SKIPLE A,INTAR
JRST CKI1A
SUB P,R70+1
POP P,A
SETZM INHIBIT
PUSHJ P,UINTEX
JRST POPXDJ
SUBTTL UUOH HANDLER (INCLUDING STRT)
;UUOH: 0 ;UUO HANDLER
UUOH0: MOVEM T,UUTSV
LDB T,[331100,,40]
CAIL T,CALL←-33
JRST UUOH0B ;PROBABLY A LISP "CALL" UUO
UUOH2: CAILE T,UUOMAX
SETZ T,
JRST @UUOH2A(T)
UUOH2A: ERRBAD ;0 IS ILGL, ILGL, ILGL
ERROR1 ;LERR ;UNCORRECTABLE LISP ERROR
UUOACL ;ACALL ;KLUDGE FOR NCALLING ARRAYS
UUOAJC ;AJCALL ;JRST VERSION OF ACALL
ERROR1 ;LER3 ;LERR, BUT ALSO PRINT ACCUMULATOR A
ERROR5 ;ERINT ;CORRECTABLE ERROR WITH SIXBIT MSG
POF1 ;PP Z$X ;PRINT OUT Z FROM DDT
STRTOUT ;STRT ;SIXBIT STRING TYPE OUT
ERROR5 ;SERINT ;CORRECTABLE ERROR WITH S-EXP MSG
TOF1 ;TP Z$X ;TYPEP PRINTOUT OF Z FROM DDT
ERRIOJ ;IOJRST ;HAIRY FROB TO GET I/O ERROR MSGS
STRTOUT ;STRT7 ;ASCII STRING TYPE OUT
IFN .-UUOH2A-1-UUOMAX, WARN [UUOH2A OUT OF PHASE]
UUOACL: PUSH P,UUOH
BAKPRO
UUOAJC: MOVE T,@40 .SEE ASAR
TLNE T,AS<FX+FL>
AOJA T,.+2 ;FOR NUMBER ARRAYS, ENTER AT HEADER+1
PUSH P,[UUONVL] ;FOR OTHER ARRAYS, USE NUMVAL CHECK ROUTINE
XCTPRO
EXCH T,UUTSV
SPECPRO INTACT
JRST @UUTSV
NOPRO
;;; DISPATCH ON "CALL" TYPE UUO, TRAPPING TO INTERPRETER IF NECESSARY
UUOH0B: CAILE T,NJCALF←-33
JRST UUOH2
MOVEM TT,UUTTSV
MOVEM R,UURSV
LDB TT,[270400,,40]
CAIG TT,15 ;LISP "CALL" TYPE UUOS
TDZA R,R
MOVEI R,-15(TT)
HRRZ T,40
UUOH0A: MOVEM T,UUOFN
TLZ T,-1
MOVEI TT,(T)
LSH TT,-SEGLOG
SKIPGE TT,ST(TT)
JRST @UUNAF(R)
TLNN TT,SY
JRST UUOH0C
TLZ R,700000 ;400000 => AUTOLOAD, 200000 => MACRO,
; 100000 => ALREADY DID AUTOLOAD
;;; FALLS THRU
;;; FALLS THRU
UUOH1: HRRZ T,(T)
JUMPE T,UUOH1A
HLRZ TT,(T)
HRRZ T,(T)
CAIL TT,QARRAY
CAILE TT,QAUTOLOAD
JRST UUOH1
2DIF JRST @(TT),UUOTRT,QARRAY
UUOH0C: TLNN TT,SA
JRST UUOH3A
HRRZ TT,ASAR(T) ;HANDLE CASE OF A SAR EFFICIENTLY
↓CAIN TT,ADEAD
α JRST UUOH3A
MOVSI T,(T)
HRRI T,T
JRST @UUAT(R)
UUOH1A: JUMPL R,UUALT1
TLNE R,200000
JRST UUOMER
PUSH P,A
PUSH P,B
SKIPGE A,UUOFN
JRST UUOUER
HLRZ T,(A) ;OPENCODED SYMEVAL
HRRO T,@(T)
UUOH3B: POP P,B
POP P,A
SKIPN EVPUNT ;SHOULD WE ALLOW FUNCTIONAL VARIABLES?
CAIN T,QUNBOUND ;YES, IS IT BOUND?
JRST UUOH3A ;NO TO EITHER QUESTION, SO ERROR
JRST UUOH0A
α
;;UEO TRANSFERTABLE, ONCE FUNCTION TYPE IS KNOWN
UUOTRT:
IRPS LL,X,[A+S+FS+L+E+FE+MC-AL-]
IFSE X,+ @UU!LL!T(R)
IFSE X,-, UU!LL!T
TERMIN
;;; MOBY DISPATCH TABLE FOR DECODING UUO CALL TYPES!
;;; R=0 => COMPILED ROUTINE CALLING A SUBR TYPE
;;; R=1 => COMPILED ROUTINE CALLING A LSUBR TYPE
;;; R=2 => COMPILED ROUTINE CALLING A FSUBR TYPE
UUAT: UUOARR ;CALLING SUBR - IT'S AN ARRAY **WIN**
UUOS1A ;CALLING LSUBR - IT'S AN ARRAY
UUOS2A ;CALLING FSUBR - IT'S AN ARRAY
UUST: UUOS0 ;CALLING SUBR - IT'S A SUBR **WIN**
UUOS1 ;CALLING LSUBR - IT'S A SUBR
UUOS2 ;CALLING FSUBR - IT'S A SUBR
UUFST: UUOS10 ;CALLING SUBR - IT'S AN FSUBR
UUOS11 ;CALLING LSUBR - IT'S AN FSUBR
UUOSBR ;CALLING FSUBR - IT'S AN FSUBR **WIN**
UULT: UUOS7 ;CALLING SUBR - IT'S AN LSUBR
UUOLSB ;CALLING LSUBR - IT'S AN LSUBR **WIN**
UUOS9 ;CALLING FSUBR - IT'S AN LSUBR
UUET: UUOEXP ;CALLING SUBR - IT'S AN EXPR
UUOS5 ;CALLING LSUBR - IT'S AN EXPR
UUOS6 ;CALLING FSUBR - IT'S AN EXPR
UUFET: UUOS3 ;CALLING SUBR - IT'S A FEXPR
UUOS4 ;CALLING LSUBR - IT'S A FEXPR
UUOEX2 ;CALLING FSUBR - IT'S A FEXPR
UUNAF: UUOS ;CALLING SUBR - IT'S A NONATOMICFUN
UUL2N ;CALLING LSUBR - IT'S A NONATOMICFUN
UUF2N ;CALLING FSUBR - IT'S A NONATOMICFUN
UUALT: HRRZM T,UUALT9 ;FOUND AN AUTOLOAD PROPERTY
TLOAR,400000
UUMCT: TLO R,200000 ;MACROS ARE IGNORED, SORT OF
JRST UUOH1
UUALT1: TLOE R,100000 ;CALLING ANYTHING - IT'S AN AUTOLOAD
α JRST UUOH3C ;LOSE IF JUST DID AN AUTOLOAD ALREADY
PUSH P,A
HLRZ A,@UUALT9 ;OTHERWISE AUTOLOAD THE FUNCTION
MOVE T,UUOFN
PUSHJ P,AUTOLOAD ;BETTER SAVE R, BY GEORGE!
POP P,A
MOVE T,UUOFN
JRST UUOH1 ;NOW TRY IT AGAIN
;;; MAY CALL UUOBNC AND UUOBAK ONLY WHEN *RSET IS KNOWN
;;; TO BE NON-NIL - AVOIDS CERTAIN TIMING ERRORS.
UUOBNC: POP P,UUOBKG ;UUOBKG WITH NO CPOPJ
HRROS UUOBKG ;FOR UUO GUYS THAT CALL IAPPLY,
JRST UUOBK0 ; WHICH ITSELF SETS UP A CPOPJ
UUOBAK: POP P,UUOBKG ;WATCH THIS CROCK!
JRST UUOBK7
;;;UUOBKG: 0
UUBKG1: SKIPN V.RSET ;CHECK TO SEE WHETHER IN *RSET MODE
JRST @UUOBKG ;SAVES ALL ACS; T HAS -<# OF ARGS>
UUOBK7: HRRZS UUOBKG
UUOBK0: SKIPE NIL
PUSHJ P,NILBAD
PUSH FXP,TT ;PDLS MUST BE AS FREDURN WOULD WANT
PUSH FXP,R ; TO RESTORE THEM TO
JUMPGE T,UUOBK1 ;IF T>0, THEN ASSUME 0, AND THE
JSP TT,ARGP0 ; ARGS WILL BE FILLED IN LATER
MOVNI TT,(T)
SKIPGE A
SETZ TT,
HRLM TT,(P)
JRST UUOBK8
UUOBK1: PUSH P,R70
UUOBK8: MOVEI TT,-2λFXP)
HRLI TT,(FLP)
PUSH P,TT
HRRZ TT,40
HRLI TT,(SP)
PUSH P,TT
JUMPLE T,UUOBK5
PUSH P,R70
JRST UUOBK6
UUOBK5: PUSH P,[$APPLYFRAME]
UUOBK6: MOVS R,40
HRRI R,CPOPJ
SKIPL UUOBKG ;MAYBE DON'T WANT THE CPOPJ
PUSH P,R
HRRZS UUOBKG
POP FXP,R
POP FXP,TT
JRST @UUOBKG
UUOSBR: HLRZ T,(T) ;*** FSUBR CALLED LIKE FSUBR
MOVEM P,UUPSV
MOVNI R,1
TLOA A,400000
UUOSB28 MOVEI R 1 ;R>0 SAYS DON#T DO FRAME HACKERY
UUOSB3: MOVE TT,40 ;OTHARWISE R HAS -<# OF ARGS>
UUOSB5: TLO T,(PUSHJ P,)
TLNE TT,(1←33) ;THE NO-PUSH, OR JRST, BIT& SEE DEFINITION OF JCALL
TDCA T,(JRST#<PUSHJ P,>)
↓PUSH P,UUOH
UUOSB6: JUMPG R,UUOSB7
EXCH T,R
JSR UUOBKG
EXCH T,R
UUOSB7: TLZ A,-1
TLNE TT,(20←33) ;THE NUMERIC CALD BIT& SEE DEFINITION OF NCALL
AOS T ;FOR NCALL, ENTER AT ENTRY+1
SKIPN VNOUUO
TLNE TT,(2←33) ;THE NO-CLOBBER BIT. SEE DEFINITION OF CALLF
JRST UUOXT0
SOS TT,UUOH
UUOSB4: LDB R,[331100,,(TT)]
CAIN R,XCT←-33
JRST UUOXCT ;MAKE XCT OF UUO WORK
MOVEM T,(TT)
UUOXT0: TLNN T,(34←33) ;CAUSE EXIT TO INDIRECT THRU ACALL
TLO T,(@)
UUOXIT: EXCH T,UUTSV
UUOXT1: MOVE TT,UUTTSV
MOVE R,UURSV
JRST @UUTSV
UUOXCT: LDB R,[220400,,(TT)] ;GET INDEP FIELD OF XCT
JUMPE R,.+2
HRRZ R,@UUOACS-1(R) ;IF NON-ZERO, GET CONTENTS OF THAT AC
ADD R,(TT) ;ADD IN ADDRESS FIELD
HLL R,(TT)
MOVEI TT,(R)
TLNE R,(@)
JRST UUOXCT ;MAKE INDIRECTION WIN
JRST UUOSB4 ;MAKE XCT OF XCT ... OF XCT OF UUO WIN
;;; TABLE OF WHERE TO FIND THE ACS AS THEY WERE ON UUO ENTRY
UUOACS:
IRPS X,,[A B C AR1 AR2A UUTSV UUTTSV D UURSV F FREEAC UUPSV FLP FXP SP]
X
TERMIN
UUOARR: HLRZ R,(T) ;*** ARRAY CALLED LIKE SUBR
MOVSI TT,(@)
JRST UUOS03
UUOS0: SETZ TT, ;*** SUBR CALLED LIKE SUBR
HRRZ R,UUOFN
UUOS03: MOVEM P,UUPSV ;THIS IS TO HELP UUOXCT
HLR TT,(T)
PUSH P,TT
LDB T,[270400,,40]
MOVNS T
PUSH FXP,T
PUSHJ P,ARGCHK ;SKIPS IF OK
JRST UUOS0E
POP FXP,R ;R NOW HAS -<# OF ARGS>
POP P,T
TLNN T,(@) ;FURTHER WORK NEEDED FOR CALLING AN ARRAY
JRST UUOSB3
MOVSI TT,TTS<CN>
HLL A,40 ;UUOSB7 WILL CLEAR LEFT HALF OF A
TLNN A,2000 ;DO NOT SET THE COMPILED-CODE-
IORM TT,TTSAR(T) ; NEEDS-ME BIT FOR A CALLF!
MOVE TT,40
TLZN TT,(20←33)
JRST UUOSB3
TLNN TT,(2←33)
JRST UUOAR2 ;NCALL'ING AN ARRAY MEANS CLOBBER,
PUSH P,[UUONVL] ; IF ANY, SHOULD BE TO ACALL
JRST UUOSB5
UUOAR2: TLNN TT,1000
TLOA T,(ACALL) ;NCALL, BUT NOT NCALLF => ACALL
TLOA T,(AJCALL) ;NJCALL, BUT NOT NJCALF => AJCALL
PUSH P,UUOH
TLZ TT,777000
TLZ T,(@)
JRST UUOSB6
UUONVL: SKOTT A,FX+FL
JRST UUONVE
FIX7: MOVE TT,(A) ;OF COURSE, THE ROUTINE HAD BETTER COME UP
POPJ P, ;WITH SOME LISP NUMBER AS VALUE
UUOS1E: PUSH FXP,D
MOVEI D,1
JRST UUOE3
UUOS2E: MOVEM D,(FXP) ;TAKE THE SPOT ALREADY PUSHED ON FXP
MOVEI D,3
UUOE3: PUSHJ P,SAVX3 ;ARGS WERE ALREADY ON PDL, HENCE MUST BE POPPED OFF
MOVEM B,QF1SB ;SO WE MIGHT AS WELL LIST THEM UP WHILE WE'RE AT IT
PUSH FXP,T
PUSHJ FXP,LISTX
POP FXP,T
MOVE B,QF1SB
JRST UUOE2
UUOS0E: SUB P,R70+1
UUOS0F: PUSH FXP,D
PUSHJ P,SAVX3
MOVEI D,0
UUOE2: TLNE D,2 ;D 1.2 => EXIT ADDRESS ALREADY BEEN HACKED
JRST .+4
MOVE R,40
TLNN R,1000
PUSH P,UUOH
PUSHJ FXP,SAV5M1
PUSHJ P,[MOVE TT,40
HRLS TT
PUSH P,TT ;NAME OF FUNCTION IN LH
TRNN D,1 ;1.1 => LISTING HAS ALREADY BEEN DONE
JSP TT,ARGP0 ;ARGS TO FUNCTION NOW ON PDL
MOVEM D,-1(FXP)
PUSHJ P,RSTX3 ;RECUPERATE - IF POSSIBLE, DO NEW EVALUATION
JRST WNAERR ;OR ELSE CRAP OUT ON WRONG NUMBER ARGS
]
UUOSE1: PUSHJ FXP,RST5M1
POP FXP,D
POPJ P,
UUOS1: HRRZ TT,(T) ;*** SUBR CALLED LIKE LSUBR
HLRZ T,(T)
EXCH T,UUTSV
JSP R,PDLARG
HRRZ R,UUOFN
PUSHJ P,ARGCK0 ;FORCE CHECKING OF NUMBER OF ARGS
JRST UUOS0F
MOVE TT,40
TLNE TT,(20←33) ;THE NCALL BIT
AOS UUTSV
TLNN TT,(1←33) ;THE NO-PUSH, OR JRST, BIT. SEE DEFINITION OF JCALL
PUSH P,UUOH
JSR UUOBKG
JRST UUOXT1
UUOX4B: SKIPN UUOH ;=0 MEANS ENTRY FROM MAP SERIES
JRST (R)
PUSHJ FXP,SAV5M1
PUSH P,CR5M1PJ
JRST (R)
UUOLSB: MOVEM P,UUPSV ;*** LSUBR CALLED LIKE LSUBR
MOVEI A,NIL
HLRZ T,(T)
SKIPN V.RSET
JRST UUOSB2
PUSH FXP,T ;SAVE T (ADDRESS OF LSUBR)
MOVE T,UUTSV
PUSH FXP,T ;SAVE -<# OF ARGS> FOR UUOFUL
HRRZ R,UUOFN ;FOR ARGCK0
PUSHJ P,ARGCK0
JRST UUOS1E
MOVE R,T ;WATCH THIS SHUFFLING OF R, T, AND UUTSV!
JSP T,NPUSH-6 ;SIX SLOTS FOR "APPLY FRAME", ETC.
MOVE T,UUTSV
MOVEM R,UUTSV
MOVEI T,(P)
UUOLB3: AOJG R,UUOLB4 ;SO SLIDE STUFF SIX SLOTS UP THE PDL
MOVE TT,-6(T) ;AT END, T POINTS TO LAST OF THE FIVE
MOVEM TT,(T) ; FRAME SLOTS FOR UUOFUL
SOJA T,UUOLB3
UUOLB4: MOVE TT,40 ;FIGURE OUT IF CALL OR CALLF TYPE
MOVEI R,CPOPJ ; (MAY BE CALL TYPE IF 0 ARGS)
TLO R,(PUSHJ P,) ;FIGURE IT OUT
TLNE TT,1000 ;IT MAY LOOK LIKE WE'RE CONSTRUCTING A PUSHJ
TLCA R,(JRST#<PUSHJ P,>) ; TO THE WRONG PLACE, BUT READ THIS CAREFULLY!
HRR R,UUOH ;RETURN ADDRESS MUST GO UNDER
HRRZM R,-5(T) ; THE FRAME, NOT OVER!!!
HLLM R,-1(FXP) ;SAVE INSTRUCTION TO CLOBBER WITH
MOVEI TT,(T)
PUSHJ P,UUOFUL ;SO STICK AN APPLY FRAME UNDER ARGS, IF ANY
;REMEMBER, UUOFUL EXPECTS TWO FROBS
; ON FXP, AND POPS ONE OF THEM
POP FXP,T ;RESTORE T (ADDRESS OF LSUBR)
MOVE TT,40
JRST UUOSB7
UUOFUL: MOVS R,40 ;PUT FRAME UNDER LSUBR CALL
HRRI R,CPOPJ ;TT POINTS TO LAST OF 5 PDL SLOTS
MOVEM R,(TT) ;USES T,TT,R
MOVEI R,-2(FXP) ;FXP HAS -<# OF ARGS> AND ONE
HRRM R,-3(TT) ; OTHER SLOT AS WELL
HRLM FLP,-3(TT)
HRLM SP,-2(TT)
HRRZ R,40
HRRM R,-2(TT)
POP FXP,T
MOVEI R,(T)
HRLI R,-1(T)
ADDI R,(P)
SKIPN T
SETZ R,
MOVEM R,-4(TT)
MOVE R,[$APPLYFRAME]
MOVEM R,-1(TT)
POPJ P,
UUOS9: SKIPA TT,CILIST ;*** LSUBR CALLED LIKE FSUBR
UUOS7: MOVEI TT,ARGPDL ;*** LSUBR CALLED LIKE SUBR
MOVE R,40
TLNN R,1000
PUSH P,UUOH
HLRZ T,(T)
TLNE R,(20←33) ;THE NCALL BIT
ADDI T,1
PUSH FXP,T
PUSH FXP,XC-1
SKIPN V.RSET
JRST UUOS7A
MOVEI T,1
PUSHJ P,UUOBAK
REPEAT 2, SOS -3(P) ;ALLOW FOR TWO FROBS ON FXP
HRRZM P,(FXP)
UUOS7A: JSP TT,(TT) ;ARGPDL OR ILIST
POP FXP,R
JUMPL R,UUOS7K
SKIPN TT,T
JRST UUOS7H
HRLI TT,-1(TT)
ADDI TT,1(P)
UUOS7H: MOVEM TT,-4(R)
MOVE TT,[$APPLYFRAME]
MOVEM TT,-1(R) ;APPLYFRAME DONE
UUOS7K: MOVEM T,UUTSV
HRRZ R,UUOFN
PUSHJ P,ARGLCK
JRST UUOS2E
POP FXP,T
MOVEI A,0
JRST UUOXIT
UUOS2A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE FSUBR
MOVEM TT,LISAR
MOVEI R,(TT)
MOVEI TT,IAPAR1
JRST UUOS2Q
UUOS2: HLRZ TT,(T) ;*** SUBR CALLED LIKE FSUBR
HRRZ R,UUOFN
UUOS2Q: MOVE T,40
TLNN T,1000
PUSH P,UUOH
TLNE T,(NCALL)
PUSH P,[UUONVL]
CAIN T,IAPAR1
PUSH P,LISAR
PUSH FXP,TT ;SUBR ADDR
CILIST: JSP TT,ILIST ;ILIST FORTUNATELY SAVES R
PUSHJ P,ARGCHK
JRST UUOS2E
JSP R,PDLARG
POP FXP,TT ;PRESERVE T FOR UUOBKG
CAIN TT,IAPAR1
POP P,LISAR
JSR UUOBKG
MOVEI T,(TT) ;BEWARE! LOOSE SUBR POINTER
JRST UUOXIT
UUOS1A: HLRZ TT,(T) ;*** ARRAY CALLED LIKE LSUBR
MOVEM TT,LISAR
MOVEI T,IAPAR1 ;HAIR SO INTERRUPTS WON'T SCREW US
EXCH T,UUTSV
JSP R,PDLARG ;SAVES TT
JSR UUOBKG ;ALSO SAVES TT, AND WANTS NOTHING ON PDLS
LDB R,[TTSDIM,,TTSAR(TT)]
MOVE TT,40
TLNN TT,1000
PUSH P,UUOH
TLNE TT,(NCALL)
PUSH P,[UUONVL]
MOVNI TT,(R) ;WNAERR will look at TT if error
CAMN TT,T
JRST UUOXT1
AOS R ;Fake an ARGS property from # of dims
PUSH FXP,D
PUSHJ P,SAVX3
JRST UUOE2
;;; PUTCODE [EXPR ← FSUBR]40
UUOS4: POP P,A ;*** FEXPR CALLED LIKE LSUBR
MOVN TT,UUTSV
JRST UUOS4A
UUF2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE FSUBR
UUOS6: HLRZ TT,(T) ;*** EXPR CALLED LIKE FSUBR
MOVE R,40
TLZN TT,-1 ;UUF2N LEAVES LH OF T ↑= 0
HRL TT,R ;OTHERWISE GET SUBR EXPR NAME IN LH
TLNN R,1000
PUSH P,UUOH
TLNE R,(20←33) ;THE NCALL BIT
PUSH P,[UUONVL]
JSP R,UUOX4B
SKIPN V.RSET
JRST UUOS6Q
PUSH P,FXP ;IF IN *RSET MODE, MAKE
HRLM FLP,(P) ; UP AN EVAL FRAME (SEE EVAL
MOVEI C,(A) ; FOR FORMAT THEREOF)
HRRZ B,40
PUSHJ P,XCONS ;MUST CONS UP FAKE ARG TO EVAL
PUSH P,A
HRLM SP,(P)
PUSH P,[$EVALFRAME]
MOVEI A,(C)
UUOS6Q: PUSH P,TT ;PUSH OF FUNCTION
MOVEI TT,IAPPLY
JRST ILIST
UUOS11: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE LSUBR
MOVE T,UUTSV
JRST UUS10A
;;; ENDCODE [EXPR ← FSUBR]
UUOS3: LDB TT,[270400,,40] ;*** FEXPR CALLED LIKE SUBR
UUOS4A: SOJN TT,UUOFER
UUOEX2: MOVEI TT,1 ;*** FEXPR CALLED LIKE FSUBR
DPB TT,[270400,,40]
TLOA A,400000
UUOS: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE SUBR
UUOEXP: HLRZ TT,(T) ;*** EXPR CALLED LIKE SUBR
LDB T,[270400,,40]
UUOEX4: MOVE R,40 ;ALL OF T,TT,R WILL BE LOST!
TLZN TT,-1 ;INSERT EXPR NAME IF WAS EXPR
HRL TT,R
TLNN R,1000
PUSH P,UUOH
MOVN T,T
SKIPE V.RSET
PUSHJ P,UUOBNC
TLNE R,(NCALL)
PUSH P,[UUONVL]
JSP R,UUOX4B
PUSH P,TT ;PUSH FUNCTION
JUMPE T,IAPPLY
MOVEM T,UUTSV
HRLZ R,UUTSV
MOVE A,1(R)
JSP T,PDLNMK
PUSH P,A ;PUSH ARGUMENT
AOBJN R,.-3
MOVE T,UUTSV
JRST IAPPLY ;APPLY FUN TO ARGS
UUOS10: MOVEM T,UUOFN ;*** FSUBR CALLED LIKE SUBR
JSP TT,ARGPDL
UUS10A: AOJN T,UUOFER
POP P,A
MOVSI T,2000
IORM T,40
MOVE T,UUOFN
JRST UUOSBR
UUL2N: SKIPA TT,40 ;*** NONATOMICFUN CALLED LIKE LSUBR
UUOS5: HLRZ TT,(T) ;*** EXPR CALLED LIKE LSUBR
MOVE T,UUTSV
CAMGE T,XC-NACS
JRST UUOS5A
JSP R,PDLARG
MOVNS T
JRST UUOEX4
UUOS5A: PUSH FXP,T ;DAMN CASE WHERE WE MUST
PUSH FXP,V.RSET ; SLIDE STUFF UP THE PDL,
MOVEI R,(P) ; DOING PDLNMK'S AS WE GO
JSP T,NPUSH-3-NACS+1 ;ROOM FOR ALL ACS BUT A, PLUS 3
SKIPE (FXP)
JSP T,NPUSH-5 ;EXTRA SLOTS FOR *RSET
MOVEI D,(P)
MOVE F,-1(FXP)
UUOS5B: MOVE A,(R) ;SO DO ALL THE PDLNMK'S
JSP T,PDLNMK
MOVEM A,(D)
SUBI R,1
SUBI D,1
AOJL F,UUOS5B
HRL TT,40 ;TT HAS BEEN SAVED - HAS FN
MOVEM TT,(D) ;SAVE FUNCTION BELOW ARGS FOR IAPPLY
SKIPE (FXP) ;D SHOULD POINT TO WHERE ACS ARE SAVED
SUBI D,5 ;FOR *RSET, MUST SAVE THE ACS UNDER THE FRAME!
REPEAT NACS-1, MOVEM B+.RPCNT,.RPCNT-NACS(D) ;SAVE ALL MARKED ACS BUT A
MOVEI TT,R5M1PJ ;PROVIDE FOR RESTORING THEM
MOVEM TT,-1(D) ;ACS WERE SAVED UNDER, NOT OVER, THE
MOVE TT,40 ; FRAME IN CASE OF AN FRETURN
MOVE F,UUOH ;MAYBE NEED RETURN ADDRESS UNDER
TLNE TT,1000 ; THE ARGS (IF NOT, USE A CPOPJ)
MOVEI F,CPOPJ
MOVEM F,-NACS-1(D)
POP FXP,F
JUMPE F,UUOS5C ;MAYBE MORE *RSET HAIR?
PUSH FXP,(FXP) ;DUPLICATE NUMBER OF ARGS ON FXP
MOVEI TT,4(D) ;TT POINTS TO THE FIVE *RSET SLOTS
MOVEM TT,-1(FXP) ;PLOP POINTER INTO PDL SLOT
PUSHJ P,UUOFUL ;SET UP APPLYFRAME (POPS FXP)
POP FXP,TT
HRRZS (TT) ;FLUSH CPOPJ - IAPPLY WILL CREATE ONE
JRST IAPPLY
UUOS5C: POP FXP,T ;NOW FOR THE IAPPLY
JRST IAPPLY ;UUOFUL WANTS TWO THINGS ON FXP, WILL POP ONE
ARGCHK: CAMGE T,XC-NACS ;CHECK NUMBER OF ARGS SUPPLIED
JRST PAERR ;R HAS ATOM PROPERTY LIST POINTER
ARGLCK: SKIPE V.RSET
JRST ARGCK2
ARGCK1: POP P,TT ;FOR SPEED, DO THIS RATHER THAN
JRST 1(TT) ;AOS (P) POPJ P,
ARGCK2: SKOTT R,SY ;R HAS SYMBOL OR SAR
JRST ARGCK5 ;MUST BE A SAR
ARGCK0: HLRZ R,(R)
HLRZ R,1(R)
JUMPE R,ARGCK1
LDB TT,[111100,,R]
JUMPN TT,ARGCK3
ARGCK4: LDB TT,[001100,,R]
MOVNI TT,-1(TT)
CAMN T,TT
AOS (P)
POPJ P,
ARGCK3: MOVNI TT,-1(TT)
CAMLE T,TT
POPJ P,
LDB TT,[001100,,R]
CAIN TT,777 ;777 IS EFFECTIVELY INFINITY
JRST POPJ1
MOVNI TT,-1(TT)
CAML T,TT
AOS (P)
POPJ P,
ARGCK5: LDB R,[TTSDIM,,TTSAR(R)]
AOJA R,ARGCK4
ARGPDL: LDB T,[270400,,40] ;ARGS => PDL -CNT=> T
MOVNS T
ARGP0: HRLZ R,T
ARGP1: JUMPE R,(TT)
PUSH P,A(R)
AOBJN R,.-1
JRST (TT)
PDLARG: CAMGE T,XC-NACS
PAERR: LERR EMS16 ;MORE THAN 5 ARGS
JRST .+1+NACS(T)
REPEAT NACS,[CONC RSTR,\<A-1+NACS-.RPCNT>,: POP P,A-1+NACS-.RPCNT
]
PDLA2: JRST (R)
MOVEI D,QSUBRCALL ;COME HERE IF SUBRCALL (Q.V.) GOT 0 ARGS
SOJA T,WNALOSE
STRTOUT:
SUBI T,STRT←-33 ;FLAG NON-ZERO IF STRT7 CALL
EXCH T,UUTSV
PUSH P,UUOH ;PUSH RETURN ADDR FOR FINAL EXIT
PUSH P,A
PUSHJ P,SAVX5
PUSH FXP,UUTSV
PUSH FXP,40
PUSH P,AR1
PUSH P,AR2A
LDB D,[270400,,(FXP)] ;AC=17 MEANS USE MSGFILES.
CAIN D,17
JRST ERP0D
SKIPN AR1,(D) ;NIL MEANS USE DEFAULT ↑R AND ↑W
JRST ERP0C
CAIN AR1,QUNBOUND ;GIVEN UNBOUND VARIABLE?
LERR [SIXBIT \UNBOUND VARIABLE IN PRINC FROM COMPILED CODE --GSB!\]
ERP0E: TLO AR1,200000
ERP0F: MOVEI A,(AR1)
LSH A,-SEGLOG
SKIPL STλA) ;MAYBE SHOULD ERRR-CHECK BETTER?
TLO AR1,400000 ;NOTE WHETHER LIST OR NOT
ERP0A: JSP T,GTRDTB
.5LOCKI
ERBPLOC==-1 ;LOCATION OF BYTE PTR ON FXPDL
ER7PLOC==-2 ;LOCATION OF STRT7-P OJ FXPDL
SKIPE ER7PLOC(FXP) ;STRT7-P?
↓ JRST ERP7A
MOVSI D,440600
HLLM D,ERBPLOC(FXP)
ERP1: ILDB TT,ERBPLOC(FXP) ;STRING BYTE POINTER IS STORED ON FXP
CAIN TT,'# ;THE .5LOCKI SAVED INHIBIT ON TOP OF FXP
JRST ERP3
CAIN TT,'!
JRST ERP6
CAIN TT,'↑
JRST ERP4
ERP5: ADDI TT,40
ERP5A: PUSHJ P,STRTYO
JRST ERP1
ERP7A: MOVSI D,440700
HLLM D,ERBPLOC(FXP)
ERP7: ILDB TT,ERBPLOC(FXP) ;STRING BYTE POINTER IS STORED ON FXP
JUMPE TT,ERP6
PUSHJ P,STRTYO
JRST ERP7
ERP0D: SKIPN AR1,VMSGFILES
JRST ERP6A
JRST ERP0E
ERP0C: SKIPE AR1,TAPWRT
HRRZ AR1,VOUTFILES
JUMPN AR1,ERP0F
SKIPE TTYOFF
JRST ERP6A
JRST ERP0A
ERP3: ILDB TT,ERBPLOC(FXP) ;QUOTE A CHAR
JRST ERP5
ERP4: ILDB TT,ERBPLOC(FXP) ;CONTROLLIFY A CHAR
ADDI TT,40
TRC TT,100
CAIE TT,↑M
JRST ERP5A
PUSHJ P,STRTYO
MOVEI TT,↑J
JRST ERP5A
ERP6: UNLOCKI ;DONE!
ERP6A: POP P,AR2A
POP P,AR1
SUB FXP,R70+2 ;FLUSH BYTE PTR AND STRT7P SWITCH
POP P,A ;RESTORE A
JRST RSTX5 ;RESTORE NUMACS AND POPJ
ENDFUN==.-1 .SEE SSYSTEM ;NO MORE FUNCTIONS BEYOND HERE
SUBTTL INITIAL STARTUP CODE
;;; NORMAL ≠G STARTUP CODE. ON FIRST RUN, THE ALLOC PHASE COMES HERE;
;;; THEREAFTER, LISPGO COMES HERE DIRECTLY.
;;; WE DO NOT HAVE THE USE OF THE PDLS UNTIL THE CALL TO ERINIX.
;;; WE DO NOT HAVE THE USE OF CONSING OF ANY SORT UNTIL THE CALL TO GCNRT.
LISP: MOVNI TT,1 ;AOBJN ON -1 LEAVES [1,,0] ON A KA10
AOBJN TT,.+1 ; BUT [0] ON A KL OR KI
MOVEM TT,KA10P
;CLEAR AND DISABLE INTERRUPT SYSTEM
IFN ITS,[
PION
.SUSET [.SPIRQC,,R70]
.SUSET [.SIFPIR,,R70]
.SUSET [.ROPTION,,TT]
TLO TT,OPTINT+OPTOPC ;NEW-STYLE INTERRUPTS AND NO PC SCREWAGE
.SUSET [.SOPTION,,TT]
TLNN TT,OPTBRK ;IF OUR SUPERIOR CLAIMS TO HANDLE BREAKS,
JRST LISP17 ; AND IF IT CLAIMS TO HAVE LISP'S SYMBOL TABLE
.BREAK 12,[..RSTP,,TT] ; VALRET A STRING TO CAUSE ≠& TYPEOUT MODE
SKIPGE TT ; TO BE S-EXP TYPEOUT (AND ≠% TO BE SQUOZE)
.VALUE [ASCIZ /↔:IF N :SYMTYP P%
≠(..TAMP\
..TPER\≠1Q
..TAMP\P%
≠):VP /]
LISP17:
] ;END OF IFN ITS
IFN D10*<1-SAIL>, JSP T,D10SET
20$ JSP R,TNXSET ;DECIDE WHICH OPSYS - TENEX OR TOPS20
; AND FIX UP PAGE ACCESSIBILITYS
IFN USELESS*<ITS\D20>, JSP T,SHAREP ;CONSIDER SHARING PAGES WITH OTHER JOBS
PION ;ENABLE INTERRUPTS
;RESET I/O SWITCHES
SETZM TAPWRT ;UWRITE FLAG (↑R)
SETZM TTYOFF ;TTY OUTPUT FLAG (↑W)
IFN JOBQIO,[
IT$ .DTTY ;SAY THIS JOB WANTS THE TTY, RATHER
IT$ JFCL ; THAN LETTING AN INFERIOR HAVE IT
IT% WARN [RETRIEVE TTY FROM INFERIOR?]
] ;END OF IFN JOBQIO
;RESET FREELISTS TO FORCE A CLEAN GARBAGE COLLECTION
REPEAT NFF, SETZM FFS+.RPCNT ;SET FREELISTS TO NIL
IFN HNKLOG+DBFLAG+CXFLAG, MOVSI A,(SETZ)
IFN HNKLOG,[
REPEAT HNKLOG+1,[
SKIPN HNSGLK+.RPCNT ;HACK TO AVOID CREATING
MOVEM A,FFH+.RPCNT ; UNNEEDED HUNK SEGMENTS
] ;END OF REPEAT HNKLOG+1
] ;END OF IFN HNKLOG
DB$ SKIPN DBSGLK ;DITTO FOR WEIRD NUMERIC TYPES
DB$ MOVEM A,FFD ;THE SETZ BIT IN THE FREELIST
CX$ SKIPN CXSGLK ; POINTER MEANS IT IS OKAY TO
CX$ MOVEM A,FFC ; HAVE NO FREE CELLS AS LONG AS
DX$ SKIPN DXSGLK ; NO ONE TRIES TO CONS ONE
DX$ MOVEM A,FFZ
SETZM GCTIM ;RESET GC TIME (SINCE RUNTIME PROBABLY GOT RESET?)
SETZM ALGCF ;RESET ALLOC FLAG - OKAY TO GC NOW
JSP T,TLVRSS ;RESET VARIOUS "TOP LEVEL VARIABLES"
JSP A,ERINIX ;SET UP PDLS, RESTORE MUNGED DATA, ENABLE INTERRUPTS
;INITIALIZE DEFAULT DIRECTORY NAMES
JSP T,PPNUSNSET
;TRY TO OPEN THE TERMINAL AS AN I/O DEVICE
PUSHJ P,OPNTTY
JFCL
;PERFORM INITIAL GARBAGE COLLECTION (BUT DON'T BOTHER TO COMPACT ARRAYS)
MOVSI T,111111
PUSHJ P,GCNRT
PUSHJ P,UDIRSET
;INITIALIZE CURRENT UNIT
;INITIALIZE VARIOUS BIZARRE TOP-LEVEL VARIABLES
MOVEI T,INR70
MOVEM T,VTTSR
MOVEI A,Q. ;INITIAL VALUE OF * IS *
MOVEM A,V.
MOVE A,VERRLIST ;SET UP FOR EVAL'ING ERRLIST
MOVEM A,VIQUOTIENT
SKIPGE AFILRD
JRST LSPRET
LIHAC: SETOM AFILRD ;HAIRY HAC TO READ, THE FIRST TIME
MOVEI A,TRUTH ; AROUND, FROM THE .LISP. (INIT) FILE
MOVEM A,TAPRED ;(SETQ ↑Q T)
JRST HACENT
IFN ITS,[
LISP43: SETZ
SIXBIT \SSTATU\
REPEAT 5, 2000,,TT ;IGNORE USELESS GARBAGE
402000,,TT ;MACHINE NAME
] ;END OF IFN ITS
10$ WAKTTY: JRST (T)
SUBTTL PPNUSNSET UDIRSET TNXSET D10SET
PPNUSNSET:
IFN D10,[
SA% GETPPN TT, ;FOR TOPS10/CMU, USE GETPPN
SA% JFCL ; (GETS PPN OF CURRENT JOB)
SA$ SETZ TT, ;FOR SAIL, WE PREFER DSKPPN
SA$ DSKPPN TT, ; (AS SET BY THE ALIAS COMMAND)
MOVEM TT,USN
MOVEM TT,TTYIF2+F.PPN
MOVEM TT,TTYOF2+F.PPN
] ;END OF IFN D10
IFN ITS,[
MOVE TT,IUSN
MOVEM TT,TTYIF2+F.SNM
MOVEM TT,TTYOF2+F.SNM
] ;END OF IFN ITS
JRST (T)
;INITIALIZE THE NAME OF THE MACHINE IN THE FEATURES LIST
;INITIALIZE (STATUS UDIR)
UDIRSET:
MOVE TT,BPSH ;IF BPEND SOMEHOW
CAMGE TT,@VBPEND ; IS LARGER THAN BPSH,
PUSHJ P,BPNDST ; SET IT EQUAL TO BPSH
IFN D10,[
PUSHJ P,SIXJBN ;INITIALIZE TEMP FILE NAME D10NAM
IFE SAIL,[
MOVEI A,QTOPS10
SKIPE CMUP
MOVEI A,QCMU
] ;END OF IFE SAIL
] ;END OF IFN D10
IFN ITS,[
.CALL LISP43 ;GETS NAME OF ITS (AI, MC, ML, DM) IN TT
.VALUE
SETZ A, ;CONVERT TO ATOMIC SYMBOL
HLRZS TT
IRP X,,[AI,ML,MC,DM]
CAIN TT,(SIXBIT \X\)
MOVEI A,Q!X
TERMIN
SKIPN A
.VALUE
] ;END OF IFN ITS
SA% 20% HRLM A,SITEFT ;SET UP (STATUS FEATURES) FOR SITE NAME
IFN D10,[
IFE SAIL,[
CAIN A,QCMU
JRST .+3
HRRZ A,SITEFT ;Can't figure out a specific site name, so just
HRRM A,OPSYFT ; splice it out, and let the generic name do.
MOVNI T,1 ;FOR NON-SAIL, TRY TO GET
SETZB TT,D ; DEFAULT SNAME BY USING PATH.
MOVEI R,0
MOVE F,[4,,T]
PATH. F,
] ;END OF IFE SAIL
MOVE D,USN ;ON FAILURE, JUST USE USN
MOVE TT,D ;PPNATM EXPECTS PPN TO BE IN AC TT
PUSHJ P,PPNATM
] ;END OF IFN D10
IFN ITS,[
MOVEI A,0
;;; Following will be done by (STATUS UDIR)
;;; MOVE TT,IUSN ;TAKE INITIAL SNAME
;;; PUSHJ P,SIXATM ;CONVERT TO ATOMIC SYMBOL
] ;END OF IFN ITS
IFN ITS\D10,[
MOVEM A,SUDIR
POPJ P,
] ;END OF IFN ITS\D10
IFN D20,[
SKIPE TENEXP
SKIPA 3,[440700,,[ASCIZ \DSK:<MACLISP>SITE.TXT\]]
HRROI 3,[ASCIZ \PS:<MACLISP>SITE.TXT\]
HRROI 1,[ASCIZ \LISP:\]
STDEV ;IS THERE A LISP: DEVICE?
SKIPA 2,3
HRROI 2,[ASCIZ \LISP:SITE.TXT\]
UDRS5: HRLZI 1,(GJ%SHT+GJ%OLD)
GTJFN
JRST UDRS2A
MOVE 3,1
MOVE 2,[<07←36>+OF%RD] ;ASCII BYTES
OPENF
JRST UDRS1A ;WILL HAVE SOMETHING IN 2
MOVNI T,<LPNBUF-1>*BYTSWD
MOVE TT,PNBP
UDRS4: BIN
JUMPE 2,UDRS1 ;HAS 0 IN 2 WHEN JUMPING
IDPB 2,TT
AOJL T,UDRS4
HALTF
UDRS1: MOVE 1,3
CLOSF
JFCL
JRST UDRS1B
UDRS1A: MOVE 1,3
RLJFN
JFCL
UDRS1B: MOVNI T,BYTSWD
IDPB 2,TT ;PADD OUT WITH 0'S
AOJL T,.-1
PUSHJ P,PNBFAT
HRLM A,SITEFT
UDRS2: SETZB 1,2
SETZ 3,
MOVEI A,QLISP
MOVEI B,QPPN
PUSHJ P,REMPROP
HRROI 1,[ASCIZ /LISP:/]
SKIPN TENEXP
STDEV ;IS THERE A LISP: DEVICE?
JRST UDIRSX
MOVEI 1,.LNSJB ;IF SO, GET THE LOGICAL TRANSLATION
HRROI 2,[ASCIZ /LISP/]
MOVE 3,PNBP
LNMST
JRST .+2
JRST UDIRS6
MOVEI 1,.LNSSY
HRROI 2,[ASCIZ /LISP/]
MOVE 3,PNBP
LNMST
JRST UDIRSX
UDIRS6: MOVE D,PNBP
MOVE F,[440700,,T]
SETZ T,
MOVNI R,5 ;PICK UP ASCII FOR REAL DEVICE IN T
UDIRS7: ILDB TT,D
JUMPE TT,UDIRSX
CAIN TT,":
JRST UDIRS8
IDPB TT,F
AOJL R,UDIRS7
JRST UDIRSX
UDIRS8: ILDB TT,D
CAIE TT,"<
JRST UDIRSX
MOVE R,PNBP ;SHUFFLE DOWN THE "<MACLISP>" PART
UDRS8A: ILDB TT,D
JUMPE TT,UDIRSX
CAIN TT,">
JRST .+3
IDPB TT,R
JRST UDRS8A
PUSH FXP,T
MOVNI T,5
SETZ TT,
IDPB TT,R ;FILL OUT WITH A WORD OF NULLS
AOJLE T,.-1
PUSHJ P,PNBFAT
PUSHJ P,NCONS
PUSH P,A
POP FXP,PNBUF
SETZM PNBUF+1
PUSHJ P,PNBFAT
POP P,B
PUSHJ P,CONS
SKIPA B,A
UDIRSX: MOVEI B,Q%ALD ;HAS (PS MACLISP) in it, for default case
SKIPE TENEXP ;OR (DSK MACLISP) for tenex systems
MOVEI B,Q%XALD
MOVEI A,QLISP
MOVEI C,QPPN
JRST PUTPROP
UDRS2A: HRRZ A,SITEFT ;Since we can't figure out a specific site
HRRM A,OPSYFT ; name, just splice it out, and let the generic
JRST UDRS2 ; name from OPSYSTEM-TYPE do.
] ;END OF IFN D20
IFN D20,[
;;;CALLED WITH JSP D, TO SET UP TENEXP. RETURNS WITH FLAG IN A AS WELL
;;; Must save R -- see JCLSET
TNXP: MOVE A,[112,,11] ;MUST BE CALLED WHEN INTERRUPTS ARE OFF
GETTAB A,
JRST TNXST9 ;LOSE IF WE CANT DECIDE!
LDB A,[141400,,A] ;3 FOR TENEX, 4 FOR TOPS-10
SUBI A,2
CAIE A,1
MOVEI A,NIL
MOVEM A,TENEXP
JRST (D)
TNXSET: JSP D,TNXP ;SETUP TENEXP FLAG, RETURN IN A
MOVEI D,1 ;REMODEL CCOC2 BITS FOR ↑←
MOVEI B,QTOPS20
JUMPE A,.+3
MOVEI D,3
MOVEI B,QTENEX
DPB D,[100200,,CCOCW2]
MOVE D,CCOCW2
MOVEM D,TTYIF2+TI.ST2
HRLM B,OPSYFT
HRLM B,SITEFT ;UDIRSET SHOULD MODIFY THIS
MOVEI TT,1←17.-SEGSIZE+1
SETZM TTYIF2+TI.ST5
SETZM VTS20P
JUMPN A,TNXST3 ;A STILL HAS TENEXP
MOVEI 1,.PRIIN
RTCHR
ERJMP TNXST3
SETOM VTS20P ;GET TERMINAL-CAPABILITIES-WORD
MOVEM 2,TTYIF2+TI.ST5 ;IF ON A TWENEX
TNXST3: MOVEI D,(TT)
LSH D,-SEGLOG ;GET SEGMENT NUMBER
HLL D,ST(D)
TLNE D,ST.$NX
JRST TNXST1
MOVSI A,.FHSLF
HRRI A,(D) ;GET PAGE NUMBER
JSP T,IPURE$ ;MAKE SURE PAGE EXISTS
AND B,[PA%RD+PA%WR+PA%EX+PA%CPY]
TLO B,(PA%RD) ;LET IT BE READABLE
TLNE D,ST.LS+ST.FX+ST.FL+ST.BGN
TLZA B,(PA%EX) ;DONT EXECUTE FROM DATA AREAS
TLO B,(PA%EX)
TLNE D,ST.PUR
JRST TNXST2
TLNE B,(PA%CPY) ;WHY WOULD BOTH PA%CPY AND PA%WR
TLZA B,(PA%WR) ; BOTH BE ON???
TLNN B,(PA%WR) ;IF ALREADY WRITEABLE, DONT MAKE
TLO B,(PA%CPY) ; COPYABLE
JRST TNXST4
TNXST2: TLZ B,(PA%CPY+PA%WR) ;NOT WRITEABLE, IF A "PURE" PAGE
SKIPN PSYSP ; PSYSP is override
TLO B,(PA%CPY)
TNXST4: SPACS
TNXST1: SUBI TT,SEGSIZE
JUMPG TT,TNXST3
JRST (R)
] ;END OF IFN D20
IFN D10*<1-SAIL>,[
D10SET:
; MOVE TT,[%CCTYP] ;KA 10 VS KL/KI 10 ?
; GETTAB TT,
; JRST .+4 ;DO RUNTIME TEST IF ENTRY NOT THERE
; CAIE TT,.CCKAX
; MOVEI TT,0
; JRST .+3
; MOVNI TT,1 ;AOBJN ON -1 LEAVES [1,,0] ON A KA10
; AOBJN TT,.+1 ; BUT [0] ON A KL OR KI
; MOVEM TT,KA10P
SETZM MONL6P
SETZM CMUP
MOVEI A,QTOPS10
HRLM A,OPSYFT
;MAYBE SOMEDAY WE COULD FIGURE OUT THE ARPA HOST NAME HERE???
HRLM A,SITEFT
MOVE A,[%CNMNT] ;GET MONITOR TYPE WORD
GETTAB A,
MOVEI A,010000 ;ASSUME TOPS-10 IF GETTAB ENTRY NOT THERE
LDB A,[.BP CN%MNT,A] ;1 = TOPS-10, 2 = ITS, 3 = TENEX, 6 = TOPS-20
SOJE A,.+3 ;REAL TOPS-10 SYSTEM, RATHER THAN SIMULATOR?
SETZB A,SGANAM ; ON VARIOUS SIMULATIONS, DONT KILL HISEG
JRST (T)
MOVE A,[%CNVER]
GETTAB A, ;GET MONITOR LEVEL NUMBER
MOVSI A,5
LDB A,[140600$,A]
CAIN A,6
SETOM MONL6P
MOVE A,[%CNFG0]
GETTAB A,
MOVE A,[ASCIZ \CMU10\]
CAME A,[ASCIZ \CMU10\]
JRST (T)
SETGM CMUP
MOVEI A,QCMU
HRLM A,OPSYFT
;MAYBE SOMEDAY WE COULD FIGURE OUT THE ARPA HOST NAME HERE???
HRLM A,SITEFT
JRST (T)
] ;END OF D10*<1-SAIL>
SUBTTL JCL INITIALIZATION ROUTINE
;;CALLED WITH REPUBN ADDR IN ACC F
;; JCHSET imagines that the job was started with some commmand line, and
;; tries to strip off the subsystem name from the TOPS-20 version
;; SJCLSET gets the entire RSCAN line
JCLSET:
IFN D20,[
TDZA R,R
SJCLSET: MOVEI R,1
] ;END OF IFN D20,
SETZM SJCLBUF ;FIRST WORD OF BUFFER IS COUNT
MOVE 1,[SJCLBUF,,SJCLBUF+1]
BLT 1,SJCLBUF+LSJCLBUF-1
IFN D10,[
MOVE R,[440700,,SJCLBUF+1]
SA% RESCAN
SA$ RESCAN A
SA% CAIA
SA$ SKIPN A
JRST JCST3
JCST4: INCHRS B
JRST JCST3
CAIE B,↑M ;IF <CR> OR <ALT> OCCURS ON COMMAND
SA% CAIN B,33
SA$ CAIN B,175
JRST JCST3 ;BEFORE A ";", THEN NO JCL
CAIE B,";
CAIN B,"(
CAIA
JRST JCST4 ;LOOP UNTIL WE FIND A ; OR (
MOVNI D,BYTSWD*LSJCLBUF
JCST2: INCHRS A
JRST JCST1
CAIN B,"( ;IF JCL STARTED WITH A (,
CAIE A,") ; ONLY UP TO THE ) IS JCL,
CAIA ; BUT WE MUST GOBBLE THE WHOLE LINE
SETO B,
JUMPL B,JCST5
AOSG D
IDPB A,R
JCST5: CAIN A,↑M ;<CR> OR <ALT> TERMINATES
JRST JCST1 ;THE COMMAND LINE
SA% CAIE A,33
SA$ CAIE A,175
JRST JCST2
JCST1: SKIPLE D
TDZA D,D ;TOO MUCH JCL => NONE AT ALL
ADDI D,BYTSWD*LSJCLBUF
JCST3: INCHRS A ;MAKE SURE NO SUPERFLUOUS CHAR
JFCL
MOVEM D,SJCLBUF
SETZ A,
IDPB A,R ;INSURE AT LEAST ONE NULL BYTE FOLLOWING THE LINE
JRST (F)
] ;END OF IFN D10
IFN D20,[
JSP D,TNXP
MOVEI 1,.RSINI ;ACTIVATE THE COMMAND LINE AS INPUT
SKIPN TENEXP
RSCAN
JRST (F)
MOVEI 1,.RSCNT ;ANYTHING THERE?
RSCAN
JRST (F)
JUMPE 1,(F)
MOVEM 1,5 ;# OF CHARS KEPT IN AC 5
MOVEM 1,4
JUMPN R,[ MOVE 3,[440700,,SJCLBUF+1]
JRST JCL1C ]
MOVEI 3,NIL ; IF NON-(), SAYS ALREADY PASSED ONE "WORD"
MOVE T,[440700,,PNBUF]
JCL1A: SOSGE 5
JRST (F)
PBIN
JUMPE 1,(F)
CAIN 1,↑M ;LOOK FOR SPACE OR CR TERMINATING SUBSYSTEM
JRST (F) ; NAME.
CAIN 1," ; LOOP, TO FLUSH THIS WORD
JRST [ JUMPN 3,JCL1B
MOVEI 3,TRUTH
SUB 4,5
CAIE 4,4 ;LOOK FOR "RUN ", AND IF FOUND
JRST JCL1B ; THEN FLUSH IT AND TAKE ONE
IDPB 1,T ; MORE WORD, WHICH SHOULD BE
IDPB 1,T ; THE SUBSYSTEM NAME.
MOVE T,[ASCII \RUN \]
CAMN T,PNBUF
JRST JCL1A
JRST JCL1B ]
CAIN 1,";
JRST JCL1B
IDPB 1,T
JRST JCL1A
JCL1B: SETZM SJCLBUF
MOVEI 1,"
MOVE 3,[440700,,SJCLBUF+1] ;AH! PUT IN AN INITIAL SPACE
IDPB 1,3
AOS SJCLBUF
JCL1C: SOSGE 5
JRST (F) ;LOOP, UNTIL RUN OUT OF RSCAN CHARS
PBIN ;MOVE RSCAN BUFFER TO OUR ADDRESS SPACE
CAIL 1," ; CHECK FOR #\SPACE
JRST [ CAIN 1,";
JRST JCL1B
IDPB 1,3
AOS SJCLBUF
JRST JCL1C ]
MOVEI 2,0
CAIE 1,↑V ;CONVERT CONTROL-CHARS, EXCEPT ↑V, TAB, CR, AND LF
CAIN 1,↑I ; TO NULLS
MOVE 2,1
CAIE 1,↑M
CAIN 1,↑J
MOVE 2,1
IDPB 2,3
JUMPE 1,(F) ;TERMINATE ON A TRUE NULL BYTE
AOS SJCLBUF
JRST JCL1C
] ;END OF IFN D20
SUBTTL INTERNAL PCLSR'ING ROUTINES
SFXTBL: ;TABLE OF LOCATIONS FOR SFX HACK
MACROLOOP NSFC,ZZM,*
SFXTBI: ;TABLE OF INSTRUCTIONS NORMALLY IN THOSE LOCATIONS
MACROLOOP NSFC,ZZN,*
PROTB: ;TABLE OF INTERRUPT PROTECTION INTERVALS
MACROLOOP NPRO,PRO,*
;;; TABLE MUST BE AN EXACT POWER OF TWO IN LENGTH SO WE CAN
;;; USE SUPER-WINNING BINARY SEARCH METHOD.
HAOLNG LOG2NPRO,<.-PROTB-1>
REPEAT <1←LOG2NPRO>-NPRO,[ INTOK,,777777
] ;END OF REPEAT <1←LOG2NPRO>-NPRO
;;; IT IS OBVIOUSLY USELESS TO USE PROTECT MACROS BEYOND THIS POINT.
;;; EXPUNGING NPRO WILL CAUSE AN ERROR IF THE PROTECT MACROS ARE USED
EXPUNGE NPRO
;;; PUSHJ FXP,$IWAIT
;;; CALLED FROM WITHIN A NORMAL INTERRUPT HANDLER TO DECIDE
;;; WHETHER IT IS SAFE TO ISSUE A USER INTERRUPT.
;;; ON FAILURE, STACKS UP THE INTERRUPT AND SKIPS.
;;; AS FOR UINT0, D CONTAINS THE INTERRUPT DESCRIPTOR WORD.
;;; INTERRUPTS MUST BE DEFERRED; PDL OVERFLOW MUST BE
;;; ENABLED. THE CONTENTS OF INTPDL POINTS TO THE INTPDL ENTRY
;;; FOR THE CURRENT INTERRUPT, WHICH CONTAINS THE SAVED
;;; CONTENTS OF D AND R. FXP MUST BE IN A USABLE STATE.
$IWAIT: HLRZ R,NOQUIT ;IF IN GC, WE ARE IN A BAD STATE
JUMPN R,IWSTAK ; AND SO MUST STACK THE INTERRUPT
HRRZ R,INTPDL
CAIE R,INTPDL+LIPSAV ;FOR NESTED PI LEVEL (E.G. PDL OVERFLOW),
JRST IWSTAK .SEE INTXIT ; ALSO STACK THE INTERRUPT
MOVEI R,(SP) ;IF THE SPECPDL IS IN SOME
MOVE F,(SP) ; KIND OF STRANGE STATE (E.G.
CAME R,ZSC2 ; INTERRUPTED OUT OF SPECBIND)
CAMN F,SPSV ; THEN MUST DO THE INTSFX HACK
JRST IWLOOK
INTSFX: MOVE F,[PUSHJ FXP,SPWIN]
MOVSI R,-NSFC .SEE SFX
MOVEM F,@SFXTBL(R) ;CLOBBER LOCATIONS MARKED BY SFX SO
AOBJN R,.-1 ; SFXPRO'ED ROUTINE WILL RETURN TO SPWIN
HRRZ F,INTPDL ;RESTORE AC'S, AND SAVE
EXCH D,IPSD(F) ; INTERRUPT DESCRIPTOR
MOVE R,IPSR(F)
PUSH FXP,IPSPC(F) ;GET PC AND FLAGS
MOVEI F,IPSF(F)
PUSH FXP,F
MOVE F,(F)
JRST 2,@-1(FXP) ;CONTINUE WHATEVER WE WERE DOING
;;; RETURN FROM SFX HACK. ROUTINE HAS DONE PUSHJ FXP,SPWIN.
SPWIN: MOVEM F,@-1(FXP) ;PRESERVE F
HRRZ F,INTPDL
POP FXP,IPSPC(F) ;PUT PC BACK INTO INTPDL FRAME,
SOS IPSPC(F) ; BACKED UP TO THE CLOBBERED INSTRUCTION
SUB FXP,R70+2
MOVEM R,IPSR(F) ;SAVE ACS D AND R
EXCH D,IPSD(F)
MOVSI R,-NSFC
SPWIN1: MOVE F,SFXTBI(R) ;RESTORE THE LOCATIONS THAT WE
MOVEM F,@SFXTBL(R) ; CLOBBERED WITH PUSHJ FXP,SPWIN
AOBJN R,SPWIN1
JRST IWWIN ;WE HAVE WON
IWLOOK: HRRZ F,INTPDL ;FAST BINARY SEARCH OF PROTECT
HRRZ R,IPSPC(F) ; TABLE ON PC INTERRUPTED FROM
PUSH FXP,D
MOVEI D,0
REPEAT LOG2NPRO,[
MOVE F,PROTB+<1←<LOG2NPRO-.RPCNT-1>>(D)
CAIL R,(F)
ADDI D,1←<LOG2NPRO-.RPCNT-1>
] ;END OF REPEAT LOG2NPRO
MOVS R,PROTB(D)
POP FXP,D
HRRZ F,INTPDL ;A USEFUL VALUE FOR F
JRST (R) ;GO TO PLACE WHICH HANDLES THIS INTERVAL
;;; COME HERE TO MOVE THE PC FORWARD OUT OF A PROTECTED INTERVAL
;;; BY EXECUTING INTERVENING INSTRUCTIONS. THE ACS ARE CORRECTLY
;;; AVAILABLE DURING THIS EXECUTION, EXCEPT FXP. THE PC FLAGS ARE
;;; NOT PRESERVED. THUS, CODE IN SUCH A PROTECTED INTERVAL SHOULD
;;; NOT USE FXP OR THE PC FLAGS. NO JUMP INSTRUCTIONS MAY BE USED;
;;; HOWEVER, SKIPS ARE HANDLED CORRECTLY.
.SEE XCTPRO
INTXCT: PUSH FXP,IPSPC(F)
EXCH D,IPSD(F) ;RESTORE ACS D, R, AND F
MOVE R,IPSR(F) ;FLAGS ARE *NOT* RESTORED
MOVEI F,IPSF(F) ;ALSO, FXP IS OUT OF WHACK (BEWARE!)
PUSH FXP,F
MOVE F,(F)
XCT @-1(FXP) ;EXECUTE AN INSTRUCTION
CAIA
AOS -1(FXP) ;HANDLE SKIPS CORRECTLY
AOS -1(FXP)
MOVEM F,@(FXP)
SUB FXP,R70+1
HRRZ F,INTPDL
MOVEM R,IPSR(F)
EXCH D,IPSD(F)
POP FXP,IPSPC(F)
JRST IWLOOK ;MAY NEED TO XCT SOME MORE
INTSYP: SOS NPFFY2 .SEE SYCONS
INTSYQ: SOS NPFFY2
INTSYX: MOVEI R,PSYCONS
JRST INTBK1
INTROT: HLRZ R,R ;PROTECT CODE OF THE FORM
SUBI R,1 ; ROT A,-SEGLOG
ROT A,SEGLOG ; ... MUNCH ...
JRST INTBK1 ; ROT A,SEGLOG
INTPPC: HLRZ R,R ;PROTECT PURE CONSER
SUBI R,1 ;BACK UP TO THE AOSL OR WHATEVER
HRRM R,IPSPC(F)
SOS @(R) ;RESTORE THE COUNTER
JRST INTOK
INTC2X: HLRM B,A ;MUST PROTECT LEFT HALF OF B FOR CONS
MOVEI R,CONS1 ;HAIRY KIND OF BACKUP FOR CONS
JRST INTBK1
INTC2Y: HLRM B,A ;MUST PROTECT LEFT HALF OF B FOR CONS
MOVEI R,%CONS1 ;HAIRY KIND OF BACKUP FOR CONS
JRST INTBK1
INTACT: HRRZ R,UUTSV .SEE UUOACL
JRST IWLOOK
INTTYX: HLRZ R,R ;ARRANGE TO GO TO INTTYR, WHICH WILL
PUSH P,R ; GET THE TTSAR BACK INTO T, THEN POPJ
MOVEI R,INTTYR .SEE TYOXCT TYIXCT TYICAL
HRRZS INHIBIT .SEE .5LKTOPOPJ
JRST INTBK1
INTACX: MOVSS A .SEE ACONS ;(RESTORES A FOR BACKUP)
MOVEI R,ACONS ;MAKE THIS THE NEW PC
JRST INTBK1
20$ INTSLP: ;FOR INTERRUPT FROM D20 SLEEP, MUST FLUSH "A"
INTZAX: SETZ A, ;CONSERS WHICH DON'T PROTECT THEIR FREELIST!
INTBAK: HLRZ R,R ;BACK UP PC TO BEGINNING
INTBK1: HRRM R,IPSPC(F) ; OF INTERVAL
INTOK: TLZ R,-1
HS$ 10$ CAIL R,HSGORG ;NO ARRAYS IN HIGH SEGMENT!
HS$ 10$ JRST IWWIN
CAML R,@VBPEND
JRST INTSFX
IWWIN: HRRZ F,INTPDL ;WE HAVE WON!
POPJ FXP,
;;; NEED WE PIOF AROUND THIS JSR UISTAK ?? E.G. WHAT ABOUT MEMERR?
IWSTAK: JSR UISTAK ;WE ARE IN A BAD STATE --
AOS (FXP) ; STACK UP THE INTERRUPT
JRST IWWIN
PGTOP INT,[INTERRUPT AND UUO HANDLERS]
SUBTTL PATCH AREA, STRUCT INSERT, BIT TABLES, AND SPACE CALCULATIONS
PATCH: PAT: XPATCH:
BLOCK PTCSIZ
PAGEUP
EPATCH==.-1
INFORM [LENGTH OF PATCH AREA = ]\EPATCH-PATCH
PG% BSYSSG==HILOC-STDHI ;CROCK - BEWARE RELOCATION!
SPCTOP SYS,,[SYSTEM]
PG% EXPUNGE BSYSSG
NPURPG==<.-BPURPG>/PAGSIZ
10$ $LOSEG
INUM==.
$INSRT STRUCT ;INITIAL LIST STRUCTURE
;;; 10$ NOW IN ** LOW SEGMENT **
NBITB==NIFSSG+NIFXSG+NIFLSG+NBNSG
ZZ==<<NBITB+1>*BTBSIZ+SEGSIZ-1>/SEGSIZ
IFN ZZ-BTSGGS,[
WARN [NEEDED NUMBER OF INITIAL BIT TABLE SEGMENTS (]\ZZ,[) DOESN'T
MATCH GUESS. (BTSGGS=]\BTSGGS,[)
]
] ;END OF IFN ZZ-BTSGGS
.ALSO .ERR
IFN LOBITSG, BFBTBS=BTBLKS+NBITB*BTBSIZ
.ELSE,[ ;;; NOTE WELL! FIRST FS SEGMENT GETS FIRST
;;; BIT BLOCK! (SEE NUNMRK, GCP6)
SPCBOT BIT
BTBLKS: -1 ;THIS WILL BE RESET BY GCINBT
BLOCK NBITB*BTBSIZ-1
BFBTBS: ;BEGINNING OF FREE BIT BLOCKS
PAGEUP
SPCTOP BIT,ST,[BIT BLOCK]
] ;END OF .ELSE
NBPSSG==1*SGS%PG ;INIT WILL MUNG ST AND PURTBL ANYWAY TO PRESERVE ALLOC
NFXPSG==1*SGS%PG ;PDL AREAS FOR INIT AND ALLOC
NFLPSG==1*SGS%PG
NPSG==1*SGS%PG
NSPSG==1*SGS%PG ;ALLOC ALTERS ALL PDL PARAMETERS!!!
IFN PAGING,[
NXFXPSG==1*SGS%PG
NXFLPSG==1*SGS%PG
NXPSG==2*SGS%PG
NXSPSG==2*SGS%PG
IFE SFA,[
IFN ML, NSCRSG==2*SGS%PG
.ELSE NSCRSG==3*SGS%PG ;ALLOW FOR PDP6 PAGE (P6)
] ;END IFE SFA
IFN SFA,[
IFN ML, NSCRSG==1*SGS%PG
.ELSE NSCRSG==2*SGS%PG ;ALLOW FOR PDP6 PAGE (P6)
] ;END IFN SFA
;;; NUMBER OF NON-EXISTENT MEMORY SEGMENTS
;;; (TAKE ALL OF CORE AND SUBTRACT OUTEVEBYTHING USEFUL!!!)
NNXMSG==NSEGS
IRP SPC,,[ZER,ST SYS,SAR,VC,XVC,IS2,SYM,XXA,XXZ,SY2,PFP,PFS,PFL,XXP
IFS,IFX IFL,BN,XXB,BIT,@PS,FXP,XFXP,FLP,XFLP,P,XP,SP,XSP,SCRU
NNXMSG==NNXMSG-N!SPC!SG
TERMIN
;;; DETERMINE ORIGINS FOR ALL SPACES ABOVA THIS POIJT
ZZX==,
IRP SPC,,[BPS,NXM,FXP,XFPP,FLP,XFLP,P,XP,SP,XSP,SCR]
B!SPC!SG==ZZX
ZZX==ZZX+N!SPC!SG*SEGSIZ
TERMIN
SPDLORG==MEMORY-<NSCBSG+NSPSG+NXSPSG>*SEGSIZ¬
PDLORG==SPDLORG-<NPSG+NXPSG>*SEGSIZ
FLPORG==PDLORG-<NFLPSG+NXFLPSG>*SEGSIZ
FXPORG==FLPORG-<NFXPSG+NXFXPSG>*SEGSIZ
] ;END OF IFN PAGING
IFE PAGING,[
ZZX==.
IRP SPC,,[FXP,FLP,P,SP,BPS]
B!SPC!SG==ZZX
ZZX==ZZX+N!SPC!SG*SEGSIZ
TERMIN
SPDLORG==BSPSG
PDLORG==BPSG
FLPORG==BFLPSG
FXPORG==BFXPSG
] ;END OF IFE PAGING
SUBTTL APOCALYPSE (END OF THE WORLD)
;FOR REL ASSEMBLIES, INIT AND ALLOC CODE OVERLAP INITIAL BPS
10$ LOC BBPSSG
$INSRT ALLOC ;INITIALIZATION AND ALLOCATION ROUTINES
PRINTX \
\ ;JUST TO MAKE LSPTTY LOOK NICER
EXPUNGE ZZ ZY ZX ZZX ZZY ZZZ ZZW
HS$ 10$ IF2, BSYSSG==HSGORG ;ANTI-RELOCATION CROCK
IF2, MACROLOOP NBITMACS,BTMC,* ;FOR BIT TYPEOUT MODE
ENDLISP:: ;END OF LISP, BY GEORGE!
VARIABLES ;NO ONE SHOULD USE VARIABLES!
IFN .-ENDLISP, WARN [OKAY, WHO'S THE WISE GUY USING VARIABLES?]
IFN D10,[
$HISEG
ENDHI:: ;END OF HIGH SEGMENT
] ;END OF IFN D10
IF2 ERRCNT==:.ERRCLT ;NUMBER OF ASSEMBLY ERRORS
¬
END INITAALIZE
β